home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1993 / Internet Info CD-ROM (Walnut Creek) (1993).iso / networking / terms / kermit / b / tsnmac.alp < prev    next >
Encoding:
Text File  |  1988-08-16  |  262.1 KB  |  9,209 lines

  1. //MWCMACRO JOB (ZZXZ,504,E,60,30),'COMMON MACROS'
  2. /*ROUTE  XEQ  MSS
  3. /*RERUN
  4. /*CNTL MILWYL,EXCLUSIVE
  5. //PROCLIB DD DSN=ZZXZMWC.PROCLIB.XA,DISP=SHR
  6. //  EXEC  MWCMLIBF,LIBRARY=COMMON,SIZE=350,INCR=50,DIR=20
  7. //SYSIN DD *
  8. ./       ADD   LIST=ALL,NAME=AAAAAAAA
  9. TITLE 'COMMON MACRO LIBRARY';
  10. BAL;
  11. ./       ADD   LIST=ALL,NAME=ADDB
  12.          MACRO
  13. &L       ADDB  &R,&A
  14.          GBLC  &SIM370
  15. &L       MMVC  4*3+3+&SIM370,&A,1
  16.          AL    &R,4*3+&SIM370
  17.          MEND
  18. ./       ADD   LIST=ALL,NAME=ADDF
  19.          MACRO
  20. &L       ADDF  &R,&A
  21.          GBLC  &CPU,&SIM370
  22.          AIF   ('&CPU' EQ '360').S360
  23. &L       UAOP  A,&R,&A
  24.          MEXIT
  25. .S360    ANOP
  26. &L       MMVC  &SIM370,&A,4
  27.          A     &R,&SIM370
  28.          MEND
  29. ./       ADD   LIST=ALL,NAME=ADDH
  30.          MACRO
  31. &L       ADDH  &R,&A
  32.          GBLC  &CPU,&SIM370
  33.          AIF   ('&CPU' EQ '360').S360
  34. &L       UAOP  AH,&R,&A
  35.          MEXIT
  36. .S360    ANOP
  37. &L       MMVC  &SIM370,&A,2
  38.          AH    &R,&SIM370
  39.          MEND
  40. ./       ADD   LIST=ALL,NAME=ADDLF
  41.          MACRO
  42. &L       ADDLF &R,&A
  43.          GBLC  &CPU,&SIM370
  44.          AIF   ('&CPU' EQ '360').S360
  45. &L       UAOP  AL,&R,&A
  46.          MEXIT
  47. .S360    ANOP
  48. &L       MMVC  &SIM370,&A,4
  49.          AL    &R,&SIM370
  50.          MEND
  51. ./       ADD   LIST=ALL,NAME=ADDLH
  52.          MACRO
  53. &L       ADDLH &R,&A
  54.          GBLC  &SIM370
  55. &L       MMVC  4*2+2+&SIM370,&A,2
  56.          AL    &R,4*2+&SIM370
  57.          MEND
  58. ./       ADD   LIST=ALL,NAME=ADDP
  59.          MACRO
  60. &L       ADDP  &R,&A
  61.          GBLC  &SIM370
  62. &L       MMVC  4*1+1+&SIM370,&A,3
  63.          AL    &R,4*1+&SIM370
  64.          MEND
  65. ./       ADD   LIST=ALL,NAME=AI
  66.          MACRO
  67. &L       AI    &R,&V
  68.          LCLA  &X
  69. .*
  70. .LOOP    ANOP
  71. &X       SETA  &X+1
  72.          AIF   (&X GT K'&V).INT
  73.          AIF   ('&V'(&X,1) GE '0' AND '&V'(&X,1) LE '9').LOOP
  74. .*
  75.          AIF   ('&R' NE '0' AND '&R' NE 'R0' AND '&R' NE 'VR0').LA
  76. &L       AL    &R,=A(&V)
  77.          MEXIT
  78. .*
  79. .INT     ANOP
  80.  AIF ('&R' NE '0' AND '&R' NE 'R0' AND '&R' NE 'VR0' AND &V LT 4096).LA
  81. &L       AL    &R,=F'&V'
  82.          MEXIT
  83. .*
  84. .LA      ANOP
  85. &L       LA    &R,&V.(,&R)
  86.          MEND
  87. ./       ADD   LIST=ALL,NAME=APRIVSCN
  88. ALP;
  89.  
  90. MACRO &&L: APRIVSCN &&BYTE,&&TYPE=;
  91.    LCLC &&LBL;
  92.    &&LBL: SETC 'ASCN&SYSNDX';
  93.  
  94.    SYSKWT TYPE,&&TYPE,(NO),COND=NO;
  95.  
  96.    &&L: SYSLBL;
  97.    BEGIN SCAN *;
  98.       SCKW &&TYPE.MAILBOX,&&LBL,CODE=AL1(KWRAFMB);
  99.       SCKW &&TYPE.MAILPEND,&&LBL,CODE=AL1(KWRAFMP);
  100.       SCKW &&TYPE.PROFILE,&&LBL,CODE=AL1(KWRAFPRO);
  101.       SCKW &&TYPE.MILTENRECOVERY,&&LBL,CODE=AL1(KWRAFRCM);
  102.       SCKW &&TYPE.TSORECOVERY,&&LBL,CODE=AL1(KWRAFRCT);
  103.       SCKW ,*,B;
  104.  
  105.       &&LBL:
  106.       ASM IF ('&TYPE' EQ 'NO')
  107.       THEN <X VRE,=XL4'FF'; EXI VRE,NI,&&BYTE,0>
  108.       ELSE EXI VRE,OI,&&BYTE,0;
  109.       SCANEND; END;
  110.    MEND;
  111. BAL;
  112. ./       ADD   LIST=ALL,NAME=APRIVSEG
  113. ALP;
  114.  
  115. MACRO &&L: APRIVSEG &&BYTE,&&BEFORE=,&&AFTER=,&&VAREA=;
  116.  
  117.    &&L: SYSLBL;
  118.    SELECT;
  119.       <TM &&BYTE,KWRAFMB>: BEGIN
  120.          APRIVSG1 'MAILBOX',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  121.          END;
  122.       <TM &&BYTE,KWRAFMP>: BEGIN
  123.         APRIVSG1 'MAILPEND',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  124.          END;
  125.       <TM &&BYTE,KWRAFPRO>: BEGIN
  126.          APRIVSG1 'PROFILE',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  127.          END;
  128.       <TM &&BYTE,KWRAFRCM>: BEGIN
  129.   APRIVSG1 'MILTENRECOVERY',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  130.          END;
  131.       <TM &&BYTE,KWRAFRCT>: BEGIN
  132.      APRIVSG1 'TSORECOVERY',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  133.          END;
  134.       ENDSEL;
  135.    MEND;
  136. BAL;
  137. ./       ADD   LIST=ALL,NAME=APRIVSG1
  138. ALP;
  139.  
  140. MACRO &&L: APRIVSG1 &&STRING,&&BEFORE=,&&AFTER=,&&VAREA=;
  141.    &&L: SYSLBL;
  142.    ASM IF ('&BEFORE' NE '')
  143.    THEN APRIVSG2 &&VAREA,&&BEFORE(1),&&BEFORE(2);
  144.    APRIVSG2 &&VAREA,&&STRING(1),&&STRING(2);
  145.    ASM IF ('&AFTER' NE '')
  146.    THEN APRIVSG2 &&VAREA,&&AFTER(1),&&AFTER(2);
  147.    MEND;
  148. BAL;
  149. ./       ADD   LIST=ALL,NAME=APRIVSG2
  150. ALP;
  151.  
  152. MACRO &&L: APRIVSG2 &&VAREA,&&A,&&N;
  153.    &&L: SYSLBL;
  154.    ASM IF ('&VAREA' EQ '')
  155.    THEN TSEG &&A,&&N
  156.    ELSE VSEG &&VAREA,&&A,&&N;
  157.    MEND;
  158. BAL;
  159. ./       ADD   LIST=ALL,NAME=AREA
  160.          MACRO
  161. &L       AREA  &ALIGN,&DSECT=
  162.          GBLC  &AREAL(10),&AREAB(10),&AREAC(10),&AREAO(50)
  163.          GBLA  &AREAN,&AREAP(10)
  164. .*
  165.    SYSKWT ALIGNMENT,&ALIGN,(X,0X,C,0C,H,0H,Y,0Y,F,0F,A,0A,D,0D),COND=NO
  166.          SYSKWT DSECT,&DSECT,(YES,NO),COND=NO
  167. .*
  168.          AIF   (&AREAN EQ 0 OR '&DSECT' NE 'YES').OKDSECT
  169.          MNOTE 12,'"DSECT=YES" ILLEGAL FOR NESTED AREA'
  170. .OKDSECT ANOP
  171. .*
  172. &AREAN   SETA  &AREAN+1
  173. &AREAL(&AREAN) SETC '&L'
  174.          AIF   ('&L' NE '').LBL
  175. &AREAL(&AREAN) SETC 'AREA&SYSNDX'
  176. .LBL     ANOP
  177. &AREAC(&AREAN) SETC '*'
  178. .*
  179. &AREAB(&AREAN) SETC '0X'
  180.          AIF   ('&ALIGN' EQ '').AOK
  181. &AREAB(&AREAN) SETC '&ALIGN'
  182.          AIF   ('&ALIGN'(1,1) EQ '0').AOK
  183. &AREAB(&AREAN) SETC '0&ALIGN'
  184. .AOK     ANOP
  185. .*
  186. &AREAP(&AREAN) SETA 0
  187. .*
  188.       AIF (('&DSECT' EQ '' OR '&DSECT' EQ 'YES') AND &AREAN EQ 1).DSECT
  189. &AREAL(&AREAN) DS &AREAB(&AREAN)
  190.          MEXIT
  191. .*
  192. .DSECT   ANOP
  193. &AREAC(&AREAN) SETC '&SYSECT'
  194. &AREAL(&AREAN) DSECT
  195.          MEND
  196. ./       ADD   LIST=ALL,NAME=AREAEND
  197.          MACRO
  198. &L       AREAEND &ALIGN
  199.          GBLC  &AREAL(10),&AREAB(10),&AREAC(10),&AREAO(50)
  200.          GBLA  &AREAN,&AREAP(10)
  201. .*
  202.    SYSKWT ALIGNMENT,&ALIGN,(X,0X,C,0C,H,0H,Y,0Y,F,0F,A,0A,D,0D),COND=NO
  203.          AIF   (&AREAN LE 0).ERR
  204. .*
  205.          AIF   ('&ALIGN' EQ '').AOK
  206. &AREAB(&AREAN) SETC '&ALIGN'
  207.          AIF   ('&ALIGN'(1,1) EQ '0').AOK
  208. &AREAB(&AREAN) SETC '0&ALIGN'
  209. .AOK     ANOP
  210. .*
  211.          DS    &AREAB(&AREAN)
  212. .*
  213.          AIF   (&AREAP(&AREAN) LE 0).NORG
  214. .ORGLOOP ANOP
  215.          ORGHIGH *,&AREAO(&AREAP(&AREAN)),BASE=&AREAL(&AREAN)
  216. &AREAP(&AREAN) SETA &AREAP(&AREAN)-1
  217.          AIF   (&AREAP(&AREAN) LE 0).NORG
  218.          AIF   (&AREAN LE 1).ORGLOOP
  219.          AIF   (&AREAP(&AREAN) GT &AREAP(&AREAN-1)).ORGLOOP
  220. .NORG    ANOP
  221. .*
  222.          AIF   ('&L' EQ '').NLEN
  223. &L       EQU   *-&AREAL(&AREAN)
  224. .NLEN    ANOP
  225. .*
  226.          AIF   ('&AREAC(&AREAN)' EQ '*').NCSECT
  227. &AREAC(&AREAN) CSECT
  228. .NCSECT  ANOP
  229. .*
  230. &AREAN   SETA  &AREAN-1
  231.          MEXIT
  232. .*
  233. .ERR     ANOP
  234.          MNOTE 12,'NO MATCHING AREA MACRO'
  235.          MEND
  236. ./       ADD   LIST=ALL,NAME=AREAORG
  237.          MACRO
  238. &L       AREAORG &ALIGN
  239.          GBLC  &AREAL(10),&AREAB(10),&AREAC(10),&AREAO(50)
  240.          GBLA  &AREAN,&AREAP(10)
  241.          LCLC  &A
  242. .*
  243.    SYSKWT ALIGNMENT,&ALIGN,(X,0X,C,0C,H,0H,Y,0Y,F,0F,A,0A,D,0D),COND=NO
  244.          AIF   (&AREAN LE 0).ERR
  245. .*
  246. &A       SETC  '&AREAB(&AREAN)'
  247.          AIF   ('&ALIGN' EQ '').AOK
  248. &A       SETC  '&ALIGN'
  249.          AIF   ('&ALIGN'(1,1) EQ '0').AOK
  250. &A       SETC  '0&ALIGN'
  251. .AOK     ANOP
  252. .*
  253.          AIF   ('&A' EQ '0X' OR '&A' EQ '0C').NDS
  254.          DS    &A
  255. .NDS     ANOP
  256. .*
  257.          AIF   ('&L' EQ '').NLEN
  258. &L       EQU   *-&AREAL(&AREAN)
  259. .NLEN    ANOP
  260. .*
  261. &AREAP(&AREAN) SETA &AREAP(&AREAN)+1
  262.          AIF   (&AREAP(&AREAN) GT 1 OR &AREAN EQ 1).NPREV
  263. &AREAP(&AREAN) SETA &AREAP(&AREAN-1)+1
  264. .NPREV   ANOP
  265. .*
  266. AREA&SYSNDX EQU *
  267. &AREAO(&AREAP(&AREAN)) SETC 'AREA&SYSNDX'
  268.          ORG   &AREAL(&AREAN)
  269.          MEXIT
  270. .*
  271. .ERR     ANOP
  272.          MNOTE 12,'NO MATCHING AREA MACRO'
  273.          MEND
  274. ./       ADD   LIST=ALL,NAME=BEH
  275.          MACRO
  276. &L       BEH   &A
  277. &L       BNL   &A
  278.          MEND
  279. ./       ADD   LIST=ALL,NAME=BEHR
  280.          MACRO
  281. &L       BEHR  &R
  282. &L       BNLR  &R
  283.          MEND
  284. ./       ADD   LIST=ALL,NAME=BER
  285.          MACRO
  286. &L       BER   &R
  287. &L       BCR   8,&R
  288.          MEND
  289. ./       ADD   LIST=ALL,NAME=BHR
  290.          MACRO
  291. &L       BHR   &R
  292. &L       BCR   2,&R
  293.          MEND
  294. ./       ADD   LIST=ALL,NAME=BLDLLIST
  295.          MACRO
  296. &L       BLDLLIST &LENGTH=58
  297.          LCLA  &C,&X,&Y,&Z
  298.          LCLB  &SW(32)
  299. .*
  300. &L       DC    Y(BLDL&SYSNDX,&LENGTH)
  301. .*
  302. &X       SETA  0-1
  303. .LOOP    ANOP
  304. &X       SETA  &X+2
  305.          AIF   (&X GT N'&SYSLIST).DONE
  306. &Z       SETA  0
  307. &Y       SETA  0-1
  308. .SELECT  ANOP
  309. &Y       SETA  &Y+2
  310.          AIF   (&Y GT N'&SYSLIST).HAVE
  311.          AIF   ('&SYSLIST(&Y+1)' EQ '').SELECT
  312.          AIF   (&SW(&Y)).SELECT
  313.          AIF   (&Z EQ 0).LOW
  314.    AIF ('&SYSLIST(&Z+1)        '(1,8) LE '&SYSLIST(&Y+1)        '(1,8))*
  315.                .SELECT
  316. .LOW     ANOP
  317. &Z       SETA  &Y
  318.          AGO   .SELECT
  319. .*
  320. .HAVE    ANOP
  321. &SYSLIST(&Z) DC CL8'&SYSLIST(&Z+1)'
  322.          DC    XL4'000000FF'
  323.          DC    XL(&LENGTH-12)'00'
  324. &SW(&Z)  SETB  1
  325. &C       SETA  &C+1
  326.          AGO   .LOOP
  327. .*
  328. .DONE    ANOP
  329. BLDL&SYSNDX EQU &C
  330.          MEND
  331. ./       ADD   LIST=ALL,NAME=BLE
  332.          MACRO
  333. &L       BLE   &A
  334. &L       BNH   &A
  335.          MEND
  336. ./       ADD   LIST=ALL,NAME=BLER
  337.          MACRO
  338. &L       BLER  &R
  339. &L       BNHR  &R
  340.          MEND
  341. ./       ADD   LIST=ALL,NAME=BLH
  342.          MACRO
  343. &L       BLH   &A
  344. &L       BNE   &A
  345.          MEND
  346. ./       ADD   LIST=ALL,NAME=BLHR
  347.          MACRO
  348. &L       BLHR  &R
  349. &L       BNER  &R
  350.          MEND
  351. ./       ADD   LIST=ALL,NAME=BLR
  352.          MACRO
  353. &L       BLR   &R
  354. &L       BCR   4,&R
  355.          MEND
  356. ./       ADD   LIST=ALL,NAME=BMP
  357.          MACRO
  358. &L       BMP   &A
  359. &L       BNZ   &A
  360.          MEND
  361. ./       ADD   LIST=ALL,NAME=BMPR
  362.          MACRO
  363. &L       BMPR  &R
  364. &L       BNZR  &R
  365.          MEND
  366. ./       ADD   LIST=ALL,NAME=BMZ
  367.          MACRO
  368. &L       BMZ   &A
  369. &L       BNP   &A
  370.          MEND
  371. ./       ADD   LIST=ALL,NAME=BMZR
  372.          MACRO
  373. &L       BMZR  &R
  374. &L       BNPR  &R
  375.          MEND
  376. ./       ADD   LIST=ALL,NAME=BMR
  377.          MACRO
  378. &L       BMR   &R
  379. &L       BCR   4,&R
  380.          MEND
  381. ./       ADD   LIST=ALL,NAME=BNEH
  382.          MACRO
  383. &L       BNEH  &A
  384. &L       BL    &A
  385.          MEND
  386. ./       ADD   LIST=ALL,NAME=BNEHR
  387.          MACRO
  388. &L       BNEHR &R
  389. &L       BLR   &R
  390.          MEND
  391. ./       ADD   LIST=ALL,NAME=BNER
  392.          MACRO
  393. &L       BNER  &R
  394. &L       BCR   7,&R
  395.          MEND
  396. ./       ADD   LIST=ALL,NAME=BNHR
  397.          MACRO
  398. &L       BNHR  &R
  399. &L       BCR   13,&R
  400.          MEND
  401. ./       ADD   LIST=ALL,NAME=BNLE
  402.          MACRO
  403. &L       BNLE  &A
  404. &L       BH    &A
  405.          MEND
  406. ./       ADD   LIST=ALL,NAME=BNLER
  407.          MACRO
  408. &L       BNLER &R
  409. &L       BHR   &R
  410.          MEND
  411. ./       ADD   LIST=ALL,NAME=BNLH
  412.          MACRO
  413. &L       BNLH  &A
  414. &L       BE    &A
  415.          MEND
  416. ./       ADD   LIST=ALL,NAME=BNLHR
  417.          MACRO
  418. &L       BNLHR &R
  419. &L       BER   &R
  420.          MEND
  421. ./       ADD   LIST=ALL,NAME=BNLR
  422.          MACRO
  423. &L       BNLR  &R
  424. &L       BCR   11,&R
  425.          MEND
  426. ./       ADD   LIST=ALL,NAME=BNMP
  427.          MACRO
  428. &L       BNMP  &A
  429. &L       BZ    &A
  430.          MEND
  431. ./       ADD   LIST=ALL,NAME=BNMPR
  432.          MACRO
  433. &L       BNMPR &R
  434. &L       BZR   &R
  435.          MEND
  436. ./       ADD   LIST=ALL,NAME=BNMZ
  437.          MACRO
  438. &L       BNMZ  &A
  439. &L       BP    &A
  440.          MEND
  441. ./       ADD   LIST=ALL,NAME=BNMZR
  442.          MACRO
  443. &L       BNMZR &R
  444. &L       BPR   &R
  445.          MEND
  446. ./       ADD   LIST=ALL,NAME=BNMR
  447.          MACRO
  448. &L       BNMR  &R
  449. &L       BCR   11,&R
  450.          MEND
  451. ./       ADD   LIST=ALL,NAME=BNOR
  452.          MACRO
  453. &L       BNOR  &R
  454. &L       BCR   14,&R
  455.          MEND
  456. ./       ADD   LIST=ALL,NAME=BNPR
  457.          MACRO
  458. &L       BNPR  &R
  459. &L       BCR   13,&R
  460.          MEND
  461. ./       ADD   LIST=ALL,NAME=BNZP
  462.          MACRO
  463. &L       BNZP  &A
  464. &L       BM    &A
  465.          MEND
  466. ./       ADD   LIST=ALL,NAME=BNZPR
  467.          MACRO
  468. &L       BNZPR &R
  469. &L       BMR   &R
  470.          MEND
  471. ./       ADD   LIST=ALL,NAME=BNZR
  472.          MACRO
  473. &L       BNZR  &R
  474. &L       BCR   7,&R
  475.          MEND
  476. ./       ADD   LIST=ALL,NAME=BOR
  477.          MACRO
  478. &L       BOR   &R
  479. &L       BCR   1,&R
  480.          MEND
  481. ./       ADD   LIST=ALL,NAME=BPR
  482.          MACRO
  483. &L       BPR   &R
  484. &L       BCR   2,&R
  485.          MEND
  486. ./       ADD   LIST=ALL,NAME=BZP
  487.          MACRO
  488. &L       BZP   &A
  489. &L       BNM   &A
  490.          MEND
  491. ./       ADD   LIST=ALL,NAME=BZPR
  492.          MACRO
  493. &L       BZPR  &R
  494. &L       BNMR  &R
  495.          MEND
  496. ./       ADD   LIST=ALL,NAME=BZR
  497.          MACRO
  498. &L       BZR   &R
  499. &L       BCR   8,&R
  500.          MEND
  501. ./       ADD   LIST=ALL,NAME=CAMODE
  502. ALP;
  503.  
  504. MACRO &&L: CAMODE &&AMODE,&®=RTNR;
  505.    GBLC &&OS;
  506.  
  507.    SYSKWT AMODE,&&AMODE,(24,31),NULL=NO,COND=NO;
  508.  
  509.    ASM CASE '&OS';
  510.       'MVS','MVT','MFT': &&L: SYSLBL;
  511.       'XA': BEGIN
  512.          &&L:
  513.          LA &®,AMOD&&@;
  514.          ASM IF ('&AMODE' EQ '31') THEN O &®,=XL4'80000000';
  515.          BSM 0,&®
  516.          AMOD&&@: SYSLBL;
  517.          END;
  518.       ENDCASE;
  519.    MEND;
  520. BAL;
  521. ./       ADD   LIST=ALL,NAME=CBAL
  522. ALP;
  523.  
  524. MACRO &&L: CBAL &®,&&ADDR;
  525.    GBLC &&CPU;
  526.  
  527.    ASM IF ('&CPU' EQ '360' OR '&CPU' EQ '370')
  528.    THEN <&&L: BAL &®,&&ADDR>
  529.    ELSE <&&L: BAS &®,&&ADDR>;
  530.    MEND;
  531. BAL;
  532. ./       ADD   LIST=ALL,NAME=CBALR
  533. ALP;
  534.  
  535. MACRO &&L: CBALR &®1,&®2;
  536.    GBLC &&CPU;
  537.  
  538.    ASM IF ('&CPU' EQ '360' OR '&CPU' EQ '370')
  539.    THEN <&&L: BALR &®1,&®2>
  540.    ELSE <&&L: BASR &®1,&®2>;
  541.    MEND;
  542. BAL;
  543. ./       ADD   LIST=ALL,NAME=CBASE
  544. ALP;
  545.  
  546. MACRO &&L: CBASE &®
  547.    GBLC &&CPU;
  548.  
  549.    ASM IF ('&CPU' EQ '360' OR '&CPU' EQ '370')
  550.    THEN <&&L: BALR &®,0>
  551.    ELSE <&&L: BASR &®,0>;
  552.    MEND;
  553. BAL;
  554. ./       ADD   LIST=ALL,NAME=CBDELINK
  555.          MACRO
  556. &L    CBDELINK &PREV,&DEL,&WORK,&CB=0,&NEXT=,&BACK=,&HEAD=,&TAIL=,&ZOT=
  557.          SYSKWT ZOT,&ZOT,(YES,NO),COND=NO
  558.          AIF   ('&BACK' NE '').BACK
  559. &L       L     &WORK,&NEXT-&CB.(,&DEL)
  560.          LTR   &PREV,&PREV
  561.          BNZ   CBD&SYSNDX.A
  562.          ST    &WORK,&HEAD
  563.          B     *+8
  564. CBD&SYSNDX.A ST &WORK,&NEXT-&CB.(,&PREV)
  565.          AIF   ('&TAIL' EQ '').NTAIL
  566.          LTR   &WORK,&WORK
  567.          BNZ   *+8
  568.          ST    &PREV,&TAIL
  569. .NTAIL   ANOP
  570.          AIF   ('&ZOT' NE 'YES').END
  571.          SLR   &WORK,&WORK
  572.          ST    &WORK,&NEXT-&CB.(,&DEL)
  573.          MEXIT
  574. .*
  575. .BACK    ANOP
  576. &L       L     &WORK,&NEXT-&CB.(,&DEL)
  577.          LTR   &PREV,&PREV
  578.          BNZ   CBD&SYSNDX.A
  579.          ST    &WORK,&HEAD
  580.          B     *+8
  581. CBD&SYSNDX.A ST &WORK,&NEXT-&CB.(,&PREV)
  582.          AIF   ('&TAIL' EQ '').NTAILB
  583.          LTR   &WORK,&WORK
  584.          BNZ   CBD&SYSNDX.B
  585.          ST    &PREV,&TAIL
  586.          B     *+8
  587.          AGO   .TAILB
  588. .*
  589. .NTAILB  ANOP
  590.          LTR   &WORK,&WORK
  591.          BZ    *+8
  592. .TAILB   ANOP
  593. .*
  594. CBD&SYSNDX.B ST &PREV,&BACK-&CB.(,&WORK)
  595.          AIF   ('&ZOT' NE 'YES').END
  596.          SLR   &WORK,&WORK
  597.          ST    &WORK,&NEXT-&CB.(,&DEL)
  598.          ST    &WORK,&BACK-&CB.(,&DEL)
  599. .END     MEND
  600. ./       ADD   LIST=ALL,NAME=CBINIT
  601. ALP;
  602.  
  603. MACRO &&L: CBINIT &&TYPE,&&LOC,&&LEN,&&ALIGN=F;
  604.    GBLC &&CBINITB,&&CBINITE,&&CBINITL,&&CBINITA;
  605.  
  606.    ASM CASE '&TYPE';
  607.       'BEGIN': BEGIN
  608.          ASM IF ('&CBINITB' NE '') THEN BEGIN
  609.             MNOTE 12,'MISSING CBINIT END';
  610.             &&CBINITE: SYSLBL;
  611.             END;
  612.          &&CBINITB: SETC 'CBI&@.B';
  613.          &&CBINITE: SETC 'CBI&@.E';
  614.          ASM IF ('&L' NE '') THEN <&&CBINITE: SETC '&L'>;
  615.          &&CBINITL: SETC 'CBI&@.L';
  616.          ASM IF ('&LEN' NE '') THEN <&&CBINITL: SETC '&LEN'>;
  617.          &&CBINITA: SETC '&LOC';
  618.  
  619.          GOTO &&CBINITE;
  620.          &&CBINITB: DS 0&&ALIGN;
  621.          END;
  622.  
  623.       'END': BEGIN
  624.          ASM IF ('&CBINITB' EQ '') THEN BEGIN
  625.             MNOTE 12,'NO MATCHING CBINIT BEGIN';
  626.             &&L: SYSLBL;
  627.             MEXIT;
  628.             END;
  629.  
  630.          &&CBINITL: EQU *-&&CBINITB;
  631.          &&L: SYSLBL;
  632.          &&CBINITE: MMVC &&CBINITA,&&CBINITB,&&CBINITL;
  633.  
  634.          &&CBINITB: SETC '';
  635.          END;
  636.       ENDCASE
  637.    ELSE BEGIN
  638.       MNOTE 12,'TYPE=&TYPE IS ILLEGAL';
  639.       &&L: SYSLBL;
  640.       END;
  641.    MEND;
  642. BAL;
  643. ./       ADD   LIST=ALL,NAME=CBDLINKH
  644.          MACRO
  645. &L       CBDLINKH &DEL,&WORK,&HEAD=,&TAIL=,&NEXT=,&BACK=,&CB=0,&ZOT=
  646.          SYSKWT ZOT,&ZOT,(YES,NO),COND=NO
  647.          AIF   ('&BACK' NE '').BACK
  648. &L       L     &WORK,&NEXT-&CB.(,&DEL)
  649.          ST    &WORK,&HEAD
  650.          AIF   ('&TAIL' EQ '').NTAIL
  651.          LTR   &WORK,&WORK
  652.          BNZ   *+8
  653.          ST    &WORK,&TAIL
  654. .NTAIL   ANOP
  655.          AIF   ('&ZOT' NE 'YES').END
  656.          SLR   &WORK,&WORK
  657.          ST    &WORK,&NEXT-&CB.(,&DEL)
  658.          MEXIT
  659. .*
  660. .BACK    ANOP
  661. &L       L     &WORK,&NEXT-&CB.(,&DEL)
  662.          ST    &WORK,&HEAD
  663.          LTR   &WORK,&WORK
  664.          AIF   ('&TAIL' EQ '').NTAILB
  665.          BZ    CBD&SYSNDX
  666.          XC    &BACK-&CB.(4,&WORK),&BACK-&CB.(&WORK)
  667.          B     *+8
  668. CBD&SYSNDX ST  &WORK,&TAIL
  669.          AGO   .ZOTB
  670. .*
  671. .NTAILB  ANOP
  672.          BZ    *+10
  673.          XC    &BACK-&CB.(4,&WORK),&BACK-&CB.(&WORK)
  674. .*
  675. .ZOTB    ANOP
  676.          AIF   ('&ZOT' NE 'YES').END
  677.          SLR   &WORK,&WORK
  678.          ST    &WORK,&NEXT-&CB.(,&DEL)
  679.          ST    &WORK,&BACK-&CB.(,&DEL)
  680. .END     MEND
  681. ./       ADD   LIST=ALL,NAME=CBDLINKT
  682.          MACRO
  683. &L CBDLINKT &PREV,&DEL,&WORK,&HEAD=,&TAIL=,&NEXT=,&BACK=,&CB=0,&ZOT=
  684.          SYSKWT ZOT,&ZOT,(YES,NO),COND=NO
  685.          AIF   ('&BACK' NE '').BACK
  686. &L       ST    &PREV,&TAIL
  687.          LTR   &PREV,&PREV
  688.          BNZ   *+8
  689.          ST    &PREV,&HEAD
  690.          AIF   ('&ZOT' NE 'YES').END
  691.          SLR   &WORK,&WORK
  692.          ST    &WORK,&NEXT-&CB.(,&DEL)
  693.          MEXIT
  694. .*
  695. .BACK    ANOP
  696. &L       ST    &PREV,&TAIL
  697.          LTR   &WORK,&PREV
  698.          BZ    CBD&SYSNDX
  699.          SLR   &WORK,&WORK
  700.          ST    &WORK,&NEXT-&CB.(,&PREV)
  701.          B     *+8
  702. CBD&SYSNDX ST  &PREV,&HEAD
  703.          AIF   ('&ZOT' NE 'YES').END
  704.          ST    &WORK,&NEXT-&CB.(,&DEL)
  705.          ST    &WORK,&BACK-&CB.(,&DEL)
  706. .END     MEND
  707. ./       ADD   LIST=ALL,NAME=CBLINK
  708.          MACRO
  709. &L       CBLINK &CUR,&ADD,&WORK,&CB=0,&NEXT=,&BACK=,&HEAD=,&TAIL=
  710.          AIF   ('&BACK' NE '').BACK
  711. &L       LTR   &CUR,&CUR
  712.          BNZ   CBL&SYSNDX.A
  713.          L     &WORK,&HEAD
  714.          ST    &WORK,&NEXT-&CB.(,&ADD)
  715.          ST    &ADD,&HEAD
  716.          B     CBL&SYSNDX.B
  717. CBL&SYSNDX.A L &WORK,&NEXT-&CB.(,&CUR)
  718.          ST    &WORK,&NEXT-&CB.(,&ADD)
  719.          ST    &ADD,&NEXT-&CB.(,&CUR)
  720.          AIF   ('&TAIL' EQ '').NTAIL
  721. CBL&SYSNDX.B LTR  &WORK,&WORK
  722.          BNZ   *+8
  723.          ST    &ADD,&TAIL
  724.          MEXIT
  725. .*
  726. .NTAIL   ANOP
  727. CBL&SYSNDX.B DS 0H
  728.          MEXIT
  729. .*
  730. .BACK    ANOP
  731. &L       LTR   &CUR,&CUR
  732.          BNZ   CBL&SYSNDX.A
  733.          ST    &CUR,&BACK-&CB.(,&ADD)
  734.          L     &WORK,&HEAD
  735.          ST    &WORK,&NEXT-&CB.(,&ADD)
  736.          ST    &ADD,&HEAD
  737.          B     CBL&SYSNDX.B
  738. CBL&SYSNDX.A L &WORK,&NEXT-&CB.(,&CUR)
  739.          ST    &ADD,&NEXT-&CB.(,&CUR)
  740.          ST    &WORK,&NEXT-&CB.(,&ADD)
  741.          ST    &CUR,&BACK-&CB.(,&ADD)
  742. CBL&SYSNDX.B LTR &WORK,&WORK
  743.          AIF   ('&TAIL' EQ '').NTAILB
  744.          BNZ   *+12
  745.          ST    &ADD,&TAIL
  746.          B     *+8
  747.          AGO   .TAILB
  748. .*
  749. .NTAILB  ANOP
  750.          BZ    *+8
  751. .TAILB   ANOP
  752.          ST    &ADD,&BACK-&CB.(,&WORK)
  753.          MEND
  754. ./       ADD   LIST=ALL,NAME=CBLINKH
  755.          MACRO
  756. &L       CBLINKH &ADD,&WORK,&CB=0,&NEXT=,&BACK=,&HEAD=,&TAIL=
  757.          AIF   ('&BACK' NE '').BACK
  758. &L       L     &WORK,&HEAD
  759.          ST    &ADD,&HEAD
  760.          ST    &WORK,&NEXT-&CB.(,&ADD)
  761.          AIF   ('&TAIL' EQ '').END
  762.          LTR   &WORK,&WORK
  763.          BNZ   *+8
  764.          ST    &ADD,&TAIL
  765.          MEXIT
  766. .*
  767. .BACK    ANOP
  768. &L       L     &WORK,&HEAD
  769.          ST    &ADD,&HEAD
  770.          ST    &WORK,&NEXT-&CB.(,&ADD)
  771.          LTR   &WORK,&WORK
  772.          AIF   ('&TAIL' EQ '').NTAILB
  773.          BNZ   *+12
  774.          ST    &ADD,&TAIL
  775.          B     *+8
  776.          AGO   .TAILB
  777. .*
  778. .NTAILB  ANOP
  779.          BZ    *+8
  780. .TAILB   ANOP
  781.          ST    &ADD,&BACK-&CB.(,&WORK)
  782.          SLR   &WORK,&WORK
  783.          ST    &WORK,&BACK-&CB.(,&ADD)
  784. .END     MEND
  785. ./       ADD   LIST=ALL,NAME=CBLINKT
  786.          MACRO
  787. &L       CBLINKT &ADD,&WORK,&CB=0,&NEXT=,&BACK=,&HEAD=,&TAIL=
  788.          AIF   ('&BACK' NE '').BACK
  789. &L       L     &WORK,&TAIL
  790.          ST    &ADD,&TAIL
  791.          LTR   &WORK,&WORK
  792.          BNZ   CBL&SYSNDX.A
  793.          ST    &ADD,&HEAD
  794.          B     *+8
  795. CBL&SYSNDX.A ST &ADD,&NEXT-&CB.(,&WORK)
  796.          SLR   &WORK,&WORK
  797.          ST    &WORK,&NEXT-&CB.(,&ADD)
  798.          MEXIT
  799. .*
  800. .BACK    ANOP
  801. &L       L     &WORK,&TAIL
  802.          ST    &ADD,&TAIL
  803.          LTR   &WORK,&WORK
  804.          BNZ   CBL&SYSNDX.A
  805.          ST    &ADD,&HEAD
  806.          B     *+8
  807. CBL&SYSNDX.A ST &ADD,&NEXT-&CB.(,&WORK)
  808.          ST    &WORK,&BACK-&CB.(,&ADD)
  809.          SLR   &WORK,&WORK
  810.          ST    &WORK,&NEXT-&CB.(,&ADD)
  811.          MEND
  812. ./       ADD   LIST=ALL,NAME=CCALL
  813.          MACRO
  814. &L       CCALL &SUBR,&TYPE,&RETURN=,&TEST=,&VRE=,&VRF=,&VR0=,&VR1=
  815.          LCLC  &LBL
  816. &LBL     SETC  '&L'
  817.          SYSKWT TYPE,&TYPE,(A,V),COND=NO
  818.          SYSKWT TEST,&TEST,(YES,NO),COND=NO
  819. .*
  820.          AIF   ('&VRE' EQ '' OR '&VRE' EQ '(VRE)').NVRE
  821. &LBL     SYSLR VRE,&VRE
  822. &LBL     SETC  ''
  823. .NVRE    ANOP
  824. .*
  825.          AIF   ('&VRF' EQ '' OR '&VRF' EQ '(VRF)').NVRF
  826. &LBL     SYSLR VRF,&VRF
  827. &LBL     SETC  ''
  828. .NVRF    ANOP
  829. .*
  830.          AIF   ('&VR0' EQ '' OR '&VR0' EQ '(VR0)').NVR0
  831. &LBL     SYSLR VR0,&VR0
  832. &LBL     SETC  ''
  833. .NVR0    ANOP
  834. .*
  835.          AIF   ('&VR1' EQ '' OR '&VR1' EQ '(VR1)').NVR1
  836. &LBL     SYSLR VR1,&VR1
  837. &LBL     SETC  ''
  838. .NVR1    ANOP
  839. .*
  840.          AIF   ('&SUBR'(1,1) EQ '(').REG
  841.          AIF   ('&TYPE' EQ 'A').A
  842. &LBL     L     RTNR,=V(&SUBR)
  843. &LBL     SETC  ''
  844. .*
  845. .BALR    ANOP
  846.          AIF   ('&TEST' NE 'YES').NTEST
  847.          LTR   RTNR,RTNR
  848.          BZ    *+6
  849. .NTEST   ANOP
  850.          CBALR RTNR,RTNR
  851.          CSAVGEN
  852.          MEXIT
  853. .*
  854. .A       ANOP
  855. &LBL     L     RTNR,=A(&SUBR)
  856. &LBL     SETC  ''
  857.          AGO   .BALR
  858. .*
  859. .REG     ANOP
  860.          AIF   ('&TEST' NE 'YES').NTESTR
  861. &LBL     LTR   &SUBR,&SUBR
  862. &LBL     SETC  ''
  863.          BZ    *+6
  864. .NTESTR  ANOP
  865. &LBL     CBALR RTNR,&SUBR
  866. &LBL     SETC  ''
  867.          CSAVGEN
  868.          MEND
  869. ./       ADD   LIST=ALL,NAME=CDESRCH
  870. ALP;
  871.  
  872. MACRO &&L: CDESRCH &&LOC,&&WORK=;
  873.    GBLC &&OS;
  874.    LCLC &&SRCH,&&TEST;
  875.  
  876.    &&SRCH: SETC 'SRCH&@';
  877.    &&TEST: SETC 'TEST&@';
  878.  
  879.    ASM CASE '&OS';
  880.       'XA': BEGIN
  881.          &&L:
  882.          SYSLR VR0,&&LOC,OP=L;  % LOCATION
  883.          STM XRA,HIGHR,20+XRA*4(STKR);  % SAVE REGS
  884.          &&SRCH: DO BEGIN
  885.             L XRA,CVTPTR;  % ADDRESS OF CVT
  886.             L XRA,CVTTCBP-CVT(,XRA); L XRA,0(,XRA);  % ADDR OF TCB
  887.             L XRB,TCBJSTCB-TCB(,XRA);  % ADDR OF JOB STEP TCB
  888.             L XRB,TCBJPQ-TCB(,XRB);  % JOB PACK QUEUE
  889.             WHILE <RNZ XRB> DO BEGIN
  890.                CBAL RTNR,&&TEST;  % CHECK THIS CDE
  891.                L XRB,CDCHAIN-CDE(,XRB);  % NEXT CDE
  892.                END;
  893.             L XRC,TCBLLS-TCB(,XRA);  % TRY THE LOAD LIST
  894.             WHILE <RNZ XRC> DO BEGIN
  895.                L XRB,LLECDPT-LLE(,XRC);  % POINTER TO CDE
  896.                IF <RNZ XRB> THEN CBAL RTNR,&&TEST;
  897.                L XRC,LLECHN-LLE(,XRC);  % NEXT LLE
  898.                END;
  899.             L XRB,CVTPTR;  % ADDR OF CVT
  900.             L XRB,CVTQLPAQ-CVT(,XRB);  % TRY THE LPA QUEUE
  901.             L XRB,0(,XRB);
  902.             WHILE <RNZ XRB> DO BEGIN
  903.                CBAL RTNR,&&TEST;
  904.                L XRB,CDCHAIN-CDE(,XRB);
  905.                END;
  906.             L XRB,CVTPTR;
  907.             L XRB,CVTLPDIA-CVT(,XRB);  % LINK PACK DIRECTORY
  908.             UNTIL <MCLC LPDENAME-LPDE(XRB),=8X'FF',8> DO BEGIN
  909.                CBAL RTNR,&&TEST;
  910.                AI XRB,LPDESIZE;
  911.                END;
  912.             LM XRA,HIGHR,20+XRA*4(STKR);  % RESTORE REGISTERS
  913.             SYSLR VR1,&&WORK,ERR='WORK AREA REQUIRED';  % ADDR FOR NAME
  914.             NUCLKUP BYADDR,NAME=(1),ADDR=(0);  % TRY THE NUCLEUS
  915.             IF <RNZ VRF> THEN <ZR VR1; EXIT FROM &&SRCH>;
  916.             LR VRE,VR0; N VRE,=XL4'7FFFFFFF';  % LOAD POINT
  917.             SYSLR VRF,&&LOC,OP=L;  % LOCATION BEING SEARCHED FOR
  918.             SR VRF,VRE;  % OFFSET
  919.             LI VR0,1;  % EXTENT NUMBER
  920.             EXIT FROM &&SRCH;
  921.  
  922.             &&TEST:
  923.             RGOTO RTNR IF <TM CDATTR-CDE(XRB),CDNIC+CDMIN>;
  924.             RGOTO RTNR IF ^<TM CDATTR2-CDE(XRB),CDXLE>;  % NO XL
  925.             IF <TM CDATTRB-CDE(XRB),CDELPDE> THEN BEGIN  % REALLY LPDE
  926.                RGOTO RTNR IF <CL VR0,LPDEXTAD-LPDE(,XRB); CC L>;  % LOW
  927.                LR VRF,VR0;
  928.                S VRF,LPDEXTAD-LPDE(,XRB);  % GET DISPLACEMENT
  929.                RGOTO RTNR IF <CL VRF,LPDEXTLN-LPDE(,XRB); CC NL>; % HIGH
  930.                END
  931.             ELSE BEGIN
  932.                RGOTO RTNR IF <TM CDATTRB-CDE(XRB),CDIDENTY>;
  933.                L XRD,CDXLMJP-CDE(,XRB);  % XL POINTER
  934.                RGOTO RTNR IF <RZ XRD>;  % NO XL
  935.                L VRF,4(,XRD);  % NO. OF EXTENTS
  936.                RGOTO RTNR IF ^<CI VRF,1>;  % NO EXTENTS
  937.                L VRE,12(XRD);  % LOAD ADDRESS
  938.                RGOTO RTNR IF <CR VR0,VRE; CC L>;  % TOO LOW
  939.                LR VRF,VR0; SR VRF,VRE;  % GET DISPLACEMENT
  940.                RGOTO RTNR IF <CMPP VRF,9(XRD); CC NL>  % TOO HIGH
  941.                | <C VRF,=XL4'00FFFFFF'; CC H>;
  942.                END;
  943.             LA VR1,CDNAME-CDE(XRB);  % MODULE NAME
  944.             LI VR0,1;  % EXTENT NUMBER
  945.             LM XRA,HIGHR,20+XRA*4(STKR);  % RESTORE REGISTERS
  946.             END;  % OF &&SRCH
  947.          LTR VR1,VR1;  % SET CC
  948.          END;
  949.       'MVT','MVS': BEGIN
  950.          &&L:
  951.          SYSLR VRF,&&LOC,OP=L;  % LOCATION
  952.          STM XRA,HIGHR,20+XRA*4(STKR);  % SAVE REGS
  953.          &&SRCH: DO BEGIN
  954.             L XRA,CVTPTR;  % ADDRESS OF CVT
  955.             L XRA,CVTTCBP-CVT(,XRA); L XRA,0(,XRA);  % ADDR OF TCB
  956.             L XRB,TCBJSTCB-TCB(,XRA);  % ADDR OF JOB STEP TCB
  957.             L XRB,TCBJPQ-TCB(,XRB);  % JOB PACK QUEUE
  958.             WHILE <ZHBR XRB; RNZ XRB> DO BEGIN
  959.                CBAL RTNR,&&TEST;  % CHECK THIS CDE
  960.                L XRB,CDCHAIN-CDE(,XRB);  % NEXT CDE
  961.                END;
  962.             L XRC,TCBLLS-TCB(,XRA);  % TRY THE LOAD LIST
  963.             WHILE <ZHBR XRC; RNZ XRC> DO BEGIN
  964.                L XRB,LLECDPT-LLE(,XRC);  % POINTER TO CDE
  965.                IF <ZHBR XRB; RNZ XRB> THEN CBAL RTNR,&&TEST;
  966.                L XRC,LLECHN-LLE(,XRC);  % NEXT LLE
  967.                END;
  968.             L XRB,CVTPTR;  % ADDR OF CVT
  969.             L XRB,CVTQLPAQ-CVT(,XRB);  % TRY THE LPA QUEUE
  970.             L XRB,0(,XRB);
  971.             WHILE <ZHBR XRB; RNZ XRB> DO BEGIN
  972.                CBAL RTNR,&&TEST;
  973.                L XRB,CDCHAIN-CDE(,XRB);
  974.                END;
  975.             ZR VR1;  % INDICATE NOT FOUND
  976.             EXIT FROM &&SRCH;
  977.  
  978.             &&TEST:
  979.             RGOTO RTNR IF <TM CDATTR-CDE(XRB),CDNIC+CDMIN>;
  980.             RGOTO RTNR IF ^<TM CDATTR2-CDE(XRB),CDXLE>;  % NO XL
  981.             L XRD,CDXLMJP-CDE(,XRB);  % XL POINTER
  982.             RGOTO RTNR IF <ZHBR XRD; RZ XRD>;  % NO XL
  983.             L VR0,4(,XRD);  % NO. OF EXTENTS
  984.             RGOTO RTNR IF <RZ VR0>;  % NO EXTENTS
  985.             LA VRE,8(,XRD);  % LIST OF LENGTHS
  986.             LR VR1,VR0; SLL VR1,2; AR VR1,VRE;  % LIST OF LOCATIONS
  987.             DO BEGIN  % SEARCH EXTENTS
  988.                IF <CMPP VRF,1(VR1); CC NL> THEN BEGIN  % NOT TOO LOW
  989.                   LR XRE,VRF; SL XRE,0(,VR1);  % GET DISPL.
  990.                   IF <CMPP XRE,1(VRE); CC L> THEN BEGIN  % WITHIN RANGE
  991.                      LA VRF,0(,XRE);  % RETURN DISPL.
  992.                      LOADP VRE,1(VR1);  % ORIGIN
  993.                      LCR VR0,VR0; A VR0,4(,XRD);  % EXTENT NO.
  994.                      LA VR1,CDNAME-CDE(,XRB);  % MODULE NAME
  995.                      LTR VR1,VR1;  % SET CC
  996.                      EXIT FROM &&SRCH;
  997.                      END;
  998.                   END;
  999.                RGOTO RTNR IF <TM 0(VR1),X'80'> | <TM 0(VRE),X'80'>;
  1000.                AI VR1,4; AI VRE,4;
  1001.                END FOR VR0;
  1002.             RGOTO RTNR;
  1003.             END;  % OF &&SRCH
  1004.          LM XRA,HIGHR,20+XRA*4(STKR);  % RESTORE REGISTERS
  1005.          END;
  1006.       ENDCASE
  1007.    ELSE BEGIN
  1008.       &&L: ZR VR1;
  1009.       MNOTE 4,'CDESRCH NOT DEFINED FOR &OS';
  1010.       END;
  1011.    MEND;
  1012. BAL;
  1013. ./       ADD   LIST=ALL,NAME=CENTER
  1014.          MACRO
  1015. &L       CENTER &R,&S,&SIZE,&ENTRY=,&BASE=,&WAR=
  1016.          LCLC  &LBL
  1017.          SYSKWT ENTRY,&ENTRY,(YES,NO),COND=NO
  1018.          SYSKWT BASE,&BASE,(YES,NO),COND=NO
  1019.          SYSKWT WAR,&WAR,(YES,NO),COND=NO
  1020. &LBL     SETC  '&L'
  1021.          AIF   ('&R&S' EQ '' OR ('&R' NE '' AND '&S' NE '')).OK
  1022.          MNOTE 12,'ILLEGAL REGISTER SPECIFICATION'
  1023. .OK      ANOP
  1024. .*
  1025. .*  GENERATE ENTRY CARD
  1026. .*
  1027.          AIF   ('&ENTRY' EQ 'NO' OR '&L' EQ '').NENTRY
  1028.          AIF   ('&L'(1,1) EQ '@').NENTRY
  1029.          ENTRY &L
  1030. .NENTRY  ANOP
  1031. .*
  1032. .*  SAVE REGISTERS
  1033. .*
  1034.          AIF   ('&R' EQ '').NSTM
  1035. &LBL     STM   &R,&S,0(STKR)
  1036. &LBL     SETC  ''
  1037. .NSTM    ANOP
  1038. .*
  1039. .*  LOAD WORK AREA REGISTER
  1040. .*
  1041.          AIF ('&WAR' EQ 'NO' OR '&R&SIZE' EQ '' OR '&SIZE' EQ '0').NWAR
  1042. &LBL     LR    WAR,STKR
  1043. &LBL     SETC  ''
  1044. .NWAR    ANOP
  1045. .*
  1046. .*  BUMP STACK POINTER BY SIZE REQUESTED
  1047. .*
  1048.          AIF   ('&SIZE' EQ '' AND '&R' NE '').RSIZE
  1049.          AIF   ('&SIZE' EQ '0' OR '&SIZE' EQ '').NSIZE
  1050. &LBL     LA    STKR,(&SIZE+3)/4*4(,STKR)
  1051. &LBL     SETC  ''
  1052.          AGO   .NSIZE
  1053. .*
  1054. .RSIZE   ANOP
  1055. &LBL     LA    STKR,(&S+1-(&R)+16*((&R)/(&S+1))/((&R)/(&S+1)))*4(,STKR)
  1056. &LBL     SETC  ''
  1057. .NSIZE   ANOP
  1058. .*
  1059. .*  LOAD BASE REGISTER
  1060. .*
  1061.          AIF   ('&BASE' EQ 'NO').NBASE
  1062. &LBL     CBASE BASER
  1063. &LBL     SETC  ''
  1064.          USING *,BASER
  1065. .NBASE   ANOP
  1066. &LBL     CSAVGEN
  1067.          MEND
  1068. ./       ADD   LIST=ALL,NAME=CEXIT
  1069.          MACRO
  1070. &L       CEXIT &R,&S,&SIZE,&WAR=,<R=,&BRANCH=
  1071.          LCLC  &LBL
  1072. &LBL     SETC  '&L'
  1073.          SYSKWT WAR,&WAR,(YES,NO),COND=NO
  1074.          SYSKWT LTR,<R,(VRF,VRE,VR0,VR1),COND=NO
  1075.          SYSKWT BRANCH,&BRANCH,(YES,NO),COND=NO
  1076. .*
  1077. .*  ADJUST STACK POINTER
  1078. .*
  1079.          AIF   ('&WAR' EQ 'NO' OR '&SIZE' EQ '0').NWAR
  1080. &LBL     LR    STKR,WAR
  1081. &LBL     SETC  ''
  1082.          AGO   .NSIZE
  1083. .*
  1084. .NWAR    ANOP
  1085.          AIF   ('&SIZE' EQ '').RSIZE
  1086.          AIF   ('&SIZE' EQ '0').NSIZE
  1087. &LBL     SL    STKR,=A((&SIZE+3)/4*4)
  1088. &LBL     SETC  ''
  1089.          AGO   .NSIZE
  1090. .*
  1091. .RSIZE   ANOP
  1092. &LBL     SL    STKR,=A(4*(&S+1-(&R)+16*((&R)/(&S+1))/((&R)/(&S+1))))
  1093. &LBL     SETC  ''
  1094. .NSIZE   ANOP
  1095. .*
  1096. .*  RESTORE REGISTERS
  1097. .*
  1098. &LBL     LM    &R,&S,0(STKR)
  1099. &LBL     SETC  ''
  1100. .*
  1101. .*  GENERATE LTR INSTRUCTION
  1102. .*
  1103.          AIF   ('<R' EQ '').NLTR
  1104.          LTR   <R,<R
  1105. .NLTR    ANOP
  1106. .*
  1107.          AIF   ('&BRANCH' EQ 'NO').NBRANCH
  1108.          BR    RTNR
  1109. .NBRANCH ANOP
  1110.          MEND
  1111. ./       ADD   LIST=ALL,NAME=CHKACCT
  1112. ALP;
  1113.  
  1114. MACRO &&L: CHKACCT;
  1115.    GBLA &&LACCT;
  1116.    GBLC &&SITE;
  1117.  
  1118.    &&L:
  1119.    WPUSHREG VRF,VR1;  % SAVE REGISTERS
  1120.    LI VRE,4;  % INIT TO BAD RETURN CODE
  1121.    CHEK&&@: DO BEGIN
  1122.       EXIT IF ^<CI VR0,&&LACCT>;  % NOT CORRECT LENGTH
  1123.  
  1124.       ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
  1125.          ASM IF (&&LACCT EQ 4)
  1126.          THEN EXIT IF <MCLC 0(VR1),=C'NONE',4>;
  1127.  
  1128.          DO BEGIN  % CHECK EACH CHARACTER
  1129.             EXIT FROM CHEK&&@
  1130.             IF ^<<<CLI 0(VR1),C'A'; CC NL> & <CLI 0(VR1),C'I'; CC NH>>
  1131.             | <<CLI 0(VR1),C'J'; CC NL> & <CLI 0(VR1),C'R'; CC NH>>
  1132.             | <<CLI 0(VR1),C'S'; CC NL> & <CLI 0(VR1),C'Z'; CC NH>>
  1133.             | <<CLI 0(VR1),C'0'; CC NL> & <CLI 0(VR1),C'9'; CC NH>>>;
  1134.             AI VR1,1;
  1135.             END FOR VR0;
  1136.          END;
  1137.       END
  1138.    THEN ZR VRE;  % INDICATE SUCCESS
  1139.    WPOPREG VRF,VR1;  % RESTORE REGISTERS
  1140.    LTR VRE,VRE;  % SET CC
  1141.    MEND;
  1142. BAL;
  1143. ./       ADD   LIST=ALL,NAME=CHKBOX
  1144. ALP;
  1145.  
  1146. MACRO &&L: CHKBOX;
  1147.    GBLA &&LBOX;
  1148.    GBLC &&SITE;
  1149.  
  1150.    &&L:
  1151.    WPUSHREG VRF,VR1;  % SAVE REGISTERS
  1152.    LI VRE,4;  % INIT TO BAD RETURN CODE
  1153.    CHEK&&@: DO BEGIN
  1154.       EXIT IF <CI VR0,&&LBOX; CC H>;  % NOT CORRECT LENGTH
  1155.  
  1156.       ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
  1157.          IF <CLI 0(VR1),C'M'> THEN BEGIN
  1158.             AI VR1,1;
  1159.             SI VR0,1;
  1160.             END;
  1161.          DO BEGIN  % CHECK EACH CHARACTER
  1162.             EXIT FROM CHEK&&@
  1163.             IF ^<<CLI 0(VR1),C'0'; CC NL> & <CLI 0(VR1),C'9'; CC NH>>;
  1164.             AI VR1,1;
  1165.             END FOR VR0;
  1166.          END;
  1167.       END
  1168.    THEN ZR VRE;  % INDICATE SUCCESS
  1169.    WPOPREG VRF,VR1;  % RESTORE REGISTERS
  1170.    LTR VRE,VRE;  % SET CC
  1171.    MEND;
  1172. BAL;
  1173. ./       ADD   LIST=ALL,NAME=CHKINIT
  1174. ALP;
  1175.  
  1176. MACRO &&L: CHKINIT;
  1177.    GBLA &&LINIT;
  1178.    GBLC &&SITE;
  1179.  
  1180.    &&L:
  1181.    WPUSHREG VRF,VR1;  % SAVE REGISTERS
  1182.    LI VRE,4;  % INIT TO BAD RETURN CODE
  1183.    CHEK&&@: DO BEGIN
  1184.       EXIT IF ^<CI VR0,&&LINIT>;  % NOT CORRECT LENGTH
  1185.  
  1186.       ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
  1187.          EXIT FROM CHEK&&@
  1188.          IF ^<<<CLI 0(VR1),C'A'; CC NL> & <CLI 0(VR1),C'I'; CC NH>>
  1189.          | <<CLI 0(VR1),C'J'; CC NL> & <CLI 0(VR1),C'R'; CC NH>>
  1190.          | <<CLI 0(VR1),C'S'; CC NL> & <CLI 0(VR1),C'Z'; CC NH>>
  1191.          %| <CLI 0(VR1),C'#'> | <CLI 0(VR1),C'$'> | <CLI 0(VR1),C'@'>
  1192.          >;
  1193.          SI VR0,1;
  1194.          DO BEGIN
  1195.             EXIT FROM CHEK&&@
  1196.             IF ^<<<CLI 1(VR1),C'A'; CC NL> & <CLI 1(VR1),C'I'; CC NH>>
  1197.             | <<CLI 1(VR1),C'J'; CC NL> & <CLI 1(VR1),C'R'; CC NH>>
  1198.             | <<CLI 1(VR1),C'S'; CC NL> & <CLI 1(VR1),C'Z'; CC NH>>
  1199.             | <<CLI 1(VR1),C'0'; CC NL> & <CLI 1(VR1),C'9'; CC NH>
  1200.                & ^<<CLI 0(VR1),C'0'; CC NL> & <CLI 0(VR1),C'9'; CC NH>>>
  1201.             %| <CLI 1(VR1),C'#'> | <CLI 1(VR1),C'$'> | <CLI 1(VR1),C'@'>
  1202.             >;
  1203.             AI VR1,1;
  1204.             END FOR VR0;
  1205.          END;
  1206.       END
  1207.    THEN ZR VRE;  % INDICATE SUCCESS
  1208.    WPOPREG VRF,VR1;  % RESTORE REGISTERS
  1209.    LTR VRE,VRE;  % SET CC
  1210.    MEND;
  1211. BAL;
  1212. ./       ADD   LIST=ALL,NAME=CHKKW
  1213. ALP;
  1214.  
  1215. MACRO &&L: CHKKW;
  1216.    GBLA &&LKW;
  1217.    GBLC &&SITE;
  1218.  
  1219.    &&L:
  1220.    WPUSHREG VRF,VR1;  % SAVE REGISTERS
  1221.    LI VRE,4;  % KW TO BAD RETURN CODE
  1222.    CHEK&&@: DO BEGIN
  1223.       EXIT IF ^<CI VR0,&&LKW>;  % NOT CORRECT LENGTH
  1224.  
  1225.       DO BEGIN  % CHECK EACH CHARACTER
  1226.          EXIT FROM CHEK&&@ IF <CLI 0(VR1),C' '>;
  1227.          AI VR1,1;
  1228.          END FOR VR0;
  1229.       END
  1230.    THEN ZR VRE;  % INDICATE SUCCESS
  1231.    WPOPREG VRF,VR1;  % RESTORE REGISTERS
  1232.    LTR VRE,VRE;  % SET CC
  1233.    MEND;
  1234. BAL;
  1235. ./       ADD   LIST=ALL,NAME=CHKTERM
  1236. ALP;
  1237.  
  1238. MACRO &&L: CHKTERM;
  1239.    GBLA &<ERM;
  1240.    GBLC &&SITE;
  1241.  
  1242.    &&L:
  1243.    WPUSHREG VRF,VR1;  % SAVE REGISTERS
  1244.    LI VRE,4;  % TERM TO BAD RETURN CODE
  1245.    CHEK&&@: DO BEGIN
  1246.       ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
  1247.          IF <CI VR0,4> & <MCLC 0(VR1),=C'NONE',4> THEN BEGIN
  1248.             WPOPREG VRF,VR1;
  1249.             LA VRF,=&<ERM.C'*';
  1250.             LR VR1,VRF; LI VR0,&<ERM;
  1251.             WPUSHREG VRF,VR1;
  1252.             ZR VRE;
  1253.             EXIT;
  1254.             END;
  1255.          END;
  1256.  
  1257.       EXIT IF ^<CI VR0,&<ERM>;  % NOT CORRECT LENGTH
  1258.  
  1259.       ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
  1260.          IF <CLI 0(VR1),C'0'; CC HE> & <CLI 0(VR1),C'9'; CC LE>
  1261.          THEN BEGIN
  1262.             SI VR0,2;  % ALLOW FOR 1ST DIGIT AND LETTER
  1263.             DO BEGIN
  1264.                AI VR1,1;
  1265.                EXIT FROM CHEK&&@
  1266.                IF ^<<CLI 0(VR1),C'0'; CC HE>
  1267.                   & <CLI 0(VR1),C'9'; CC LE>>;
  1268.                END FOR VR0;
  1269.             EXIT FROM CHEK&&@
  1270.             IF ^<<<CLI 1(VR1),C'A'; CC HE> & <CLI 1(VR1),C'I'; CC LE>>
  1271.             | <<CLI 1(VR1),C'J'; CC HE> & <CLI 1(VR1),C'R'; CC LE>>
  1272.             | <<CLI 1(VR1),C'S'; CC HE> & <CLI 1(VR1),C'Z'; CC LE>>>;
  1273.             END
  1274.          ELSE BEGIN
  1275.             EXIT FROM CHEK&&@
  1276.             IF ^<<<CLI 0(VR1),C'A'; CC HE> & <CLI 0(VR1),C'I'; CC LE>>
  1277.             | <<CLI 0(VR1),C'J'; CC HE> & <CLI 0(VR1),C'R'; CC LE>>
  1278.             | <<CLI 0(VR1),C'S'; CC HE> & <CLI 0(VR1),C'Z'; CC LE>>>;
  1279.             FOREVER DO BEGIN
  1280.                AI VR1,1; SI VR0,1;
  1281.                EXIT IF <RNP VR0>;
  1282.                EXIT FROM CHEK&&@
  1283.                IF ^<<CLI 0(VR1),C'0'; CC HE>
  1284.                   & <CLI 0(VR1),C'9'; CC LE>>;
  1285.                END;
  1286.             END;
  1287.          END;
  1288.       END
  1289.    THEN ZR VRE;  % INDICATE SUCCESS
  1290.    WPOPREG VRF,VR1;  % RESTORE REGISTERS
  1291.    LTR VRE,VRE;  % SET CC
  1292.    MEND;
  1293. BAL;
  1294. ./       ADD   LIST=ALL,NAME=CI
  1295.          MACRO
  1296. &L       CI    &R,&V
  1297.          LCLA  &X
  1298. .LOOP    ANOP
  1299. &X       SETA  &X+1
  1300.          AIF   (&X GT K'&V).F
  1301.          AIF   ('&V'(&X,1) GE '0').LOOP
  1302.          AIF  (&X EQ 1 AND ('&V'(1,1) EQ '-' OR '&V'(1,1) EQ '+')).LOOP
  1303. &L       C     &R,=A(&V)
  1304.          MEXIT
  1305. .F       ANOP
  1306. &L       C     &R,=F'&V'
  1307.          MEND
  1308. ./       ADD   LIST=ALL,NAME=CIL
  1309.          MACRO
  1310. &L       CIL   &R,&V
  1311.          LCLA  &X
  1312. .LOOP    ANOP
  1313. &X       SETA  &X+1
  1314.          AIF   (&X GT K'&V).F
  1315.          AIF   ('&V'(&X,1) GE '0').LOOP
  1316.          AIF  (&X EQ 1 AND ('&V'(1,1) EQ '-' OR '&V'(1,1) EQ '+')).LOOP
  1317. &L       CL    &R,=A(&V)
  1318.          MEXIT
  1319. .F       ANOP
  1320. &L       CL    &R,=F'&V'
  1321.          MEND
  1322. ./       ADD   LIST=ALL,NAME=CMPB
  1323.          MACRO
  1324. &L       CMPB  &R,&A
  1325.          GBLC  &CPU,&SIM370
  1326.          AIF   ('&CPU' EQ '360').S360
  1327. &L       CLM   &R,1,&A
  1328.          MEXIT
  1329. .S360    ANOP
  1330. &L       ST    &R,&SIM370
  1331.          MCLC  3+&SIM370,&A,1
  1332.          MEND
  1333. ./       ADD   LIST=ALL,NAME=CMPF
  1334.          MACRO
  1335. &L       CMPF  &R,&A
  1336.          GBLC  &CPU,&SIM370
  1337.          AIF   ('&CPU' EQ '360').S360
  1338. &L       UAOP  C,&R,&A
  1339.          MEXIT
  1340. .S360    ANOP
  1341. &L       MMVC  &SIM370,&A,4
  1342.          C     &R,&SIM370
  1343.          MEND
  1344. ./       ADD   LIST=ALL,NAME=CMPH
  1345.          MACRO
  1346. &L       CMPH  &R,&A
  1347.          GBLC  &CPU,&SIM370
  1348.          AIF   ('&CPU' EQ '360').S360
  1349. &L       UAOP  CH,&R,&A
  1350.          MEXIT
  1351. .S360    ANOP
  1352. &L       MMVC  &SIM370,&A,2
  1353.          CH    &R,&SIM370
  1354.          MEND
  1355. ./       ADD   LIST=ALL,NAME=CMPLF
  1356.          MACRO
  1357. &L       CMPLF &R,&A
  1358.          GBLC  &CPU,&SIM370
  1359.          AIF   ('&CPU' EQ '360').S360
  1360. &L       UAOP  CL,&R,&A
  1361.          MEXIT
  1362. .S360    ANOP
  1363. &L       MMVC  &SIM370,&A,4
  1364.          CL    &R,&SIM370
  1365.          MEND
  1366. ./       ADD   LIST=ALL,NAME=CMPLH
  1367.          MACRO
  1368. &L       CMPLH &R,&A
  1369.          GBLC  &CPU,&SIM370
  1370.          AIF   ('&CPU' EQ '360').S360
  1371. &L       CLM   &R,3,&A
  1372.          MEXIT
  1373. .S360    ANOP
  1374. &L       ST    &R,&SIM370
  1375.          MCLC  2+&SIM370,&A,2
  1376.          MEND
  1377. ./       ADD   LIST=ALL,NAME=CMPP
  1378.          MACRO
  1379. &L       CMPP  &R,&A
  1380.          GBLC  &CPU,&SIM370
  1381.          AIF   ('&CPU' EQ '360').S360
  1382. &L       CLM   &R,7,&A
  1383.          MEXIT
  1384. .S360    ANOP
  1385. &L       ST    &R,&SIM370
  1386.          MCLC  1+&SIM370,&A,3
  1387.          MEND
  1388. ./       ADD   LIST=ALL,NAME=CPARMALL
  1389. *
  1390. *  NIH/COMMON - NO ASSEMBLY PARAMETER VALUES FOR ALL VERSIONS
  1391. *
  1392. ./       ADD   LIST=ALL,NAME=CPARMGBL
  1393. ./       NUMBER NEW1=0,INCR=0
  1394. *
  1395. *  NIH/COMMON - ASSEMBLY PARAMETER DEFINITIONS
  1396. *
  1397.          GBLC  &CPU                    CPU TYPE
  1398.          GBLC  &MP                     MULTIPROCESSOR OPTION
  1399.          GBLC  &OS                     OPERATING SYSTEM
  1400.          GBLC  &JES                    TYPE OF JES TO BE USED
  1401.          GBLA  &LJOBNUM                LENGTH OF JOB NUMBER
  1402.          GBLA  &MJOBNUM                MAXIMUM JOB NUMBER
  1403.          GBLC  &MSGCLAS                DEFAULT MESSAGE CLASS
  1404.          GBLA  &MREMOTE                MAXIMUM REMOTE NUMBER
  1405.          GBLA  &LJESCMD                MAX. LENGTH OF JES COMMAND
  1406.          GBLA  &LJESMSG                MAX. LENGTH OF JES NOTIFY MSG
  1407.          GBLC  &JESCHAR                STARTING CHARACTER FOR JES CMDS
  1408.          GBLC  &DBC                    USE DBC (DEBUGGING CONTROLLER)
  1409.          GBLA  &DBCSP                  SUBPOOL TO BE USED BY DBC
  1410.          GBLC  &SITE                   SITE OF INSTALLATION
  1411.          GBLC  &SITENAM(8)             INSTALLATION NAME
  1412.          GBLC  &FORHELP(8)             WHERE TO GO FOR HELP
  1413.          GBLA  &LINIT                  LENGTH OF INITIALS
  1414.          GBLA  &LACCT                  LENGTH OF ACCOUNT
  1415.          GBLA  &LKW                    LENGTH OF KEYWORD
  1416.          GBLA  <ERM                  LENGTH OF TERMINAL ID
  1417.          GBLA  &LBOX                   LENGTH OF BOX NUMBER
  1418.          GBLC  &INITNAM                NAME FOR INITIALS
  1419.          GBLC  &ACCTNAM                NAME FOR ACCOUNT
  1420.          GBLC  &KWNAME                 NAME FOR KEYWORD
  1421.          GBLC  &TERMNAM                NAME FOR TERMINAL ID
  1422.          GBLC  &BOXNAME                NAME FOR BOX
  1423.          GBLC  &RACF                   RACF SUPPORT
  1424.          GBLC  &RACFID                 NAME FOR RACF USERID
  1425.          GBLA  &RACFSP                 SUBPOOL FOR RACF
  1426.          GBLA  &SVCGEN1                GENERAL PURPOSE TYPE 1 SVC NO.
  1427.          GBLA  &SVCGEN2                GENERAL PURPOSE TYPE 2 SVC NO.
  1428.          GBLA  &SVCJES                 REMOTE JOB ENTRY SVC NUMBER
  1429.          GBLA  &SVCKW                  KEYWORD SVC NUMBER
  1430.          GBLA  &SVCACCT                ACCOUNTING SVC NUMBER
  1431.          GBLA  &VAREA                  LENGTH OF A VAREA
  1432.          GBLA  &LSCAN                  SCANNER TOKEN SIZE FOR PADDING
  1433.          GBLC  &LNMIN                  MINIMUM LINE NUMBER
  1434.          GBLC  &LNMAX                  MAXIMUM LINE NUMBER
  1435.          GBLC  &LNMAXZ                 &LNMAX WITH 0S INSTEAD OF 9S
  1436.          GBLC  &LN1                    LINE NUMBER 1
  1437.          GBLC  &LNDP                   DECIMAL PLACES IN LINE NUMBER
  1438.          GBLC  &LNIP                   INTEGER PLACES IN LINE NUMBER
  1439.          GBLC  &LNMASK                 LINE NUMBER MASK
  1440.          GBLC  &LNBITS                 NO. OF BITS IN LINE NUMBER
  1441.          GBLC  &SIM370                 WORK AREA FOR 370 SIMULATION
  1442.          GBLA  &TIME128                128 DAYS IN 100THS OF A SECOND
  1443.          GBLA  &WTOMAX                 MAXIMUM TEXT LENGTH IN A WTO
  1444.          GBLA  &WTOMC              WTO ROUTECDE - MASTER CONSOLE
  1445.          GBLA  &WTOMCI             WTO ROUTECDE - MASTER CONSOLE INFO
  1446.          GBLA  &WTOTAPE            WTO ROUTECDE - TAPE POOL
  1447.          GBLA  &WTODISK            WTO ROUTECDE - DISK POOL
  1448.          GBLA  &WTOTLIB            WTO ROUTECDE - TAPE LIBRARY
  1449.          GBLA  &WTODLIB            WTO ROUTECDE - DISK LIBRARY
  1450.          GBLA  &WTOUREC            WTO ROUTECDE - UNIT RECORD POOL
  1451.          GBLA  &WTOTPC             WTO ROUTECDE - TELEPROCESSING
  1452.          GBLA  &WTOSSEC            WTO ROUTECDE - SYSTEM SECURITY
  1453.          GBLA  &WTOERR             WTO ROUTECDE - ERROR LOG
  1454.          GBLA  &WTOPROG            WTO ROUTECDE - PROGRAMMER
  1455.          GBLA  &WTOEMUL            WTO ROUTECDE - EMULATION
  1456.          GBLA  &WTOURC1            WTO ROUTECDE - USER CODE 1
  1457.          GBLA  &WTOURC2            WTO ROUTECDE - USER CODE 2
  1458.          GBLA  &WTOURC3            WTO ROUTECDE - USER CODE 3
  1459.          GBLA  &WTOFAIL            WTO DESC - SYSTEM FAILURE
  1460.          GBLA  &WTOIACT            WTO DESC - IMMEDIATE ACTION
  1461.          GBLA  &WTOEACT            WTO DESC - EVENTUAL ACTION
  1462.          GBLA  &WTOSTAT            WTO DESC - SYSTEM STATUS
  1463.          GBLA  &WTOCMDR            WTO DESC - COMMAND RESPONSE
  1464.          GBLA  &WTOJOB             WTO DESC - JOB STATUS
  1465.          GBLA  &WTOAPPL            WTO DESC - APPLICATION PROGRAM
  1466.          GBLA  &WTOOUTL            WTO DESC - OUT-OF-LINE MESSAGE
  1467.          GBLA  &WTODISP            WTO DESC - DYNAMIC STATUS DISPLAYS
  1468.          GBLA  &WTOCRIT            WTO DESC - CRITICAL EVENTUAL ACTION
  1469.          GBLA  &TEMP                   WORK VARIABLE
  1470. ./       ADD   LIST=ALL,NAME=CPARMPRT
  1471. *
  1472. *  NIH/COMMON - ASSEMBLY PARAMETER LISTING
  1473. *
  1474.          MNOTE *,'&&CPU=&CPU'
  1475.          MNOTE *,'&&MP=&MP'
  1476.          MNOTE *,'&&OS=&OS'
  1477.          MNOTE *,'&&JES=&JES'
  1478.          MNOTE *,'&&LJOBNUM=&LJOBNUM'
  1479.          MNOTE *,'&&MJOBNUM=&MJOBNUM'
  1480.          MNOTE *,'&&MSGCLAS=&MSGCLAS'
  1481.          MNOTE *,'&&MREMOTE=&MREMOTE'
  1482.          MNOTE *,'&&LJESCMD=&LJESCMD'
  1483.          MNOTE *,'&&LJESMSG=&LJESMSG'
  1484.          MNOTE *,'&&JESCHAR=&JESCHAR'
  1485.          MNOTE *,'&&DBC=&DBC'
  1486.          MNOTE *,'&&DBCSP=&DBCSP'
  1487.          MNOTE *,'&&SITE=&SITE'
  1488.          MNOTE *,'&&SITENAM=''&SITENAM(1)&SITENAM(2)&SITENAM(3)&SITENAM*
  1489.                (4)&SITENAM(5)&SITENAM(6)&SITENAM(7)&SITENAM(8)'''
  1490.          MNOTE *,'&&FORHELP=''&FORHELP(1)&FORHELP(2)&FORHELP(3)&FORHELP*
  1491.                (4)&FORHELP(5)&FORHELP(6)&FORHELP(7)&FORHELP(8)'''
  1492.          MNOTE *,'&&LINIT=&LINIT'
  1493.          MNOTE *,'&&LACCT=&LACCT'
  1494.          MNOTE *,'&&LKW=&LKW'
  1495.          MNOTE *,'&<ERM=<ERM'
  1496.          MNOTE *,'&&LBOX=&LBOX'
  1497.          MNOTE *,'&&INITNAM=&INITNAM'
  1498.          MNOTE *,'&&ACCTNAM=&ACCTNAM'
  1499.          MNOTE *,'&&KWNAME=&KWNAME'
  1500.          MNOTE *,'&&TERMNAM=&TERMNAM'
  1501.          MNOTE *,'&&BOXNAME=&BOXNAME'
  1502.          MNOTE *,'&&RACF=&RACF'
  1503.          MNOTE *,'&&RACFID=&RACFID'
  1504.          MNOTE *,'&&RACFSP=&RACFSP'
  1505.          MNOTE *,'&&SVCGEN1=&SVCGEN1'
  1506.          MNOTE *,'&&SVCGEN2=&SVCGEN2'
  1507.          MNOTE *,'&&SVCJES=&SVCJES'
  1508.          MNOTE *,'&&SVCKW=&SVCKW'
  1509.          MNOTE *,'&&SVCACCT=&SVCACCT'
  1510.          MNOTE *,'&&VAREA=&VAREA'
  1511.          MNOTE *,'&&LSCAN=&LSCAN'
  1512.          MNOTE *,'&&LNMIN=&LNMIN'
  1513.          MNOTE *,'&&LNMAX=&LNMAX'
  1514.          MNOTE *,'&&LNMAXZ=&LNMAXZ'
  1515.          MNOTE *,'&&LN1=&LN1'
  1516.          MNOTE *,'&&LNDP=&LNDP'
  1517.          MNOTE *,'&&LNIP=&LNIP'
  1518.          MNOTE *,'&&LNMASK=&LNMASK'
  1519.          MNOTE *,'&&LNBITS=&LNBITS'
  1520.          MNOTE *,'&&SIM370=&SIM370'
  1521.          MNOTE *,'&&TIME128=&TIME128'
  1522.          MNOTE *,'&&WTOMAX=&WTOMAX'
  1523.          MNOTE *,'&&WTOMC=&WTOMC'
  1524.          MNOTE *,'&&WTOMCI=&WTOMCI'
  1525.          MNOTE *,'&&WTOTAPE=&WTOTAPE'
  1526.          MNOTE *,'&&WTODISK=&WTODISK'
  1527.          MNOTE *,'&&WTOTLIB=&WTOTLIB'
  1528.          MNOTE *,'&&WTODLIB=&WTODLIB'
  1529.          MNOTE *,'&&WTOUREC=&WTOUREC'
  1530.          MNOTE *,'&&WTOTPC=&WTOTPC'
  1531.          MNOTE *,'&&WTOSSEC=&WTOSSEC'
  1532.          MNOTE *,'&&WTOERR=&WTOERR'
  1533.          MNOTE *,'&&WTOPROG=&WTOPROG'
  1534.          MNOTE *,'&&WTOEMUL=&WTOEMUL'
  1535.          MNOTE *,'&&WTOURC1=&WTOURC1'
  1536.          MNOTE *,'&&WTOURC2=&WTOURC2'
  1537.          MNOTE *,'&&WTOURC3=&WTOURC3'
  1538.          MNOTE *,'&&WTOFAIL=&WTOFAIL'
  1539.          MNOTE *,'&&WTOIACT=&WTOIACT'
  1540.          MNOTE *,'&&WTOEACT=&WTOEACT'
  1541.          MNOTE *,'&&WTOSTAT=&WTOSTAT'
  1542.          MNOTE *,'&&WTOCMDR=&WTOCMDR'
  1543.          MNOTE *,'&&WTOJOB=&WTOJOB'
  1544.          MNOTE *,'&&WTOAPPL=&WTOAPPL'
  1545.          MNOTE *,'&&WTOOUTL=&WTOOUTL'
  1546.          MNOTE *,'&&WTODISP=&WTODISP'
  1547.          MNOTE *,'&&WTOCRIT=&WTOCRIT'
  1548. ./       ADD   LIST=ALL,NAME=CPARMRNG
  1549.          SYSKWT &&CPU,&CPU,(360,370,370BS),COND=NO,NULL=NO
  1550.          SYSKWT &&MP,&MP,(YES,NO),NULL=NO,COND=NO
  1551.          SYSKWT &&OS,&OS,(MVT,MFT,VS1,SVS,MVS,XA),COND=NO,NULL=NO
  1552.          SYSKWT &&JES,&JES,(NIHHASP3,NIHJES2A),COND=NO,NULL=NO
  1553.          SYSRNG &&LJOBNUM,&LJOBNUM,GT,0,LE,8
  1554.          SYSRNG &&MJOBNUM,&MJOBNUM,GT,0,LE,99999999
  1555. .*       NO CHECK ON &MSGCLAS
  1556.          SYSRNG &&MREMOTE,&MREMOTE,GT,0,LE,99999
  1557.          SYSRNG &&LJESCMD,&LJESCMD,GT,0,LE,255
  1558.          SYSRNG   &&LJESMSG,&LJESMSG,GT,0,LT,&LJESCMD
  1559. .*       NO CHECK ON &JESCHAR
  1560.          SYSKWT DBC,&DBC,(YES,NO),NULL=NO,COND=NO
  1561.          SYSRNG &&DBCSP,&DBCSP,GE,2,LE,127,NE,78
  1562. .*       NO CHECK ON &SITE
  1563. .*       NO CHECK ON &SITENAM
  1564. .*       NO CHECK NO &FORHELP
  1565.          SYSRNG &&LINIT,&LINIT,GE,0,LE,8
  1566.          SYSRNG &&LACCT,&LACCT,GE,0,LE,8
  1567.          SYSRNG &&LKW,&LKW,GE,0,LE,8
  1568.          SYSRNG &<ERM,<ERM,GE,0,LE,8
  1569.          SYSRNG &&LBOX,&LBOX,GE,0,LE,8
  1570. .*       NO CHECK ON &INITNAM
  1571. .*       NO CHECK ON &ACCTNAM
  1572. .*       NO CHECK ON &KWNAME
  1573. .*       NO CHECK ON &TERMNAM
  1574. .*       NO CHECK ON &BOXNAME
  1575.          SYSKWT &&RACF,&RACF,(YES,NO),NULL=NO,COND=NO
  1576. .*       NO CHECK ON &RACFID
  1577.          SYSRNG &&RACFSP,&RACFSP,GE,0,LE,127
  1578.          SYSRNG &&SVCGEN1,&SVCGEN1,GE,0,LE,255
  1579.          SYSRNG &&SVCGEN2,&SVCGEN2,GE,0,LE,255
  1580.          SYSRNG &&SVCJES,&SVCJES,GE,0,LE,255
  1581.          SYSRNG &&SVCKW,&SVCKW,GE,0,LE,255
  1582.          SYSRNG &&SVCACCT,&SVCACCT,GE,0,LE,255
  1583.          SYSRNG &&VAREA,&VAREA,EQ,36
  1584.          SYSRNG &&LSCAN,&LSCAN,GE,16
  1585.          SYSRNG &&LNDP,&LNDP,GE,0,LE,8
  1586.          SYSRNG &&LNIP,&LNIP,GE,0,LE,8
  1587. &TEMP    SETA   &LNIP+&LNDP
  1588.          SYSRNG &&LNIP+&&LNDP,&TEMP,GT,0,LE,8
  1589. .*       NO CHECK ON &SIM370
  1590. .*       NO CHECK ON &TIME128
  1591.          SYSRNG &&WTOMAX,&WTOMAX,GE,9,LT,255
  1592. .*       NO CHECK ON WTO CODES
  1593. .*       NO CHECK ON &TEMP
  1594. ./       ADD   LIST=ALL,NAME=CPARMSET
  1595. *
  1596. *  NIH/COMMON - ASSEMBLY PARAMETER DEFAULTS
  1597. *
  1598. &CPU     SETC  '370BS'                 CPU TYPE
  1599. &MP      SETC  'YES'                   MULTIPROCESSOR OPTION
  1600. &OS      SETC  'MVS'                   OPERATING SYSTEM
  1601. &JES     SETC  'NIHJES2A'
  1602. &LJOBNUM SETA  4                       LENGTH OF JOB NUMBER
  1603. &MJOBNUM SETA  9999                    MAXIMUM JOB NUMBER
  1604. &MSGCLAS SETC  'A'                     DEFAULT MESSAGE CLASS
  1605. &MREMOTE SETA  999                     MAXIMUM REMOTE NUMBER
  1606. &LJESCMD SETA  132                     MAX. LENGTH OF JES COMMAND
  1607. &LJESMSG SETA  106                     MAX. LENGTH OF JES NOTIFY MSG
  1608. &JESCHAR SETC  '$'                     STARTING CHARACTER FOR JES CMDS
  1609. &DBC     SETC  'NO'                    USE DBC (DEBUGGING CONTROLLER)
  1610. &DBCSP   SETA  2
  1611. &SITE    SETC  'NIH'                   SITE OF INSTALLATION
  1612. &SITENAM(1) SETC 'NIH/DCRT'            INSTALLATION NAME
  1613. &SITENAM(2) SETC '/CCB'
  1614. &SITENAM(3) SETC '  WYLBUR'
  1615. &FORHELP(1) SETC 'SEE THE '            HELP MESSAGE
  1616. &FORHELP(2) SETC 'PAL UNIT'
  1617. &LINIT   SETA  3                       LENGTH OF INITIALS
  1618. &LACCT   SETA  4                       LENGTH OF ACCOUNT
  1619. &LKW     SETA  3                       LENGTH OF KEYWORD
  1620. <ERM   SETA  3                       LENGTH OF TERMINAL ID
  1621. &LBOX    SETA  4                       LENGTH OF BOX NUMBER
  1622. &INITNAM SETC  'INITIALS'              NAME FOR INITIALS
  1623. &ACCTNAM SETC  'ACCOUNT'               NAME FOR ACCOUNT
  1624. &KWNAME  SETC  'KEYWORD'               NAME FOR KEYWORD
  1625. &TERMNAM SETC  'TERMINAL'              NAME FOR TERMINAL ID
  1626. &BOXNAME SETC  'BOX'                   NAME FOR BOX NUMBER
  1627. &RACF    SETC  'NO'                    RACF SUPPORT
  1628. &RACFID  SETC  'USERID'                NAME FOR RACF USERID
  1629. &RACFSP  SETA  3                       SUBPOOL FOR RACF
  1630. &SVCGEN1 SETA  251                     GENERAL PURPOSE TYPE 1 SVC NO.
  1631. &SVCGEN2 SETA  244                     GENERAL PURPOSE TYPE 2 SVC NO.
  1632. &SVCJES  SETA  254                     REMOTE JOB ENTRY SVC
  1633. &SVCKW   SETA  254                     KEYWORD SVC
  1634. &SVCACCT SETA  242                     ACCOUNTING SVC
  1635. &VAREA   SETA  36                      LENGTH OF A VAREA
  1636. &LSCAN   SETA  16                      SCANNER TOKEN SIZE FOR PADDING
  1637. &LNDP    SETC  '3'                     DECIMAL PLACES IN LINE NUMBER
  1638. &LNIP    SETC  '5'                     INTEGER PLACES IN LINE NUMBER
  1639. &SIM370  SETC  'SIM370'                WORK AREA FOR 370 SIMULATION
  1640. &TIME128 SETA  128*24*3600*100         128 DAYS IN 100THS OF A SECOND
  1641. &WTOMAX  SETA  62                      MAXIMUM TEXT LENGTH IN A WTO
  1642. &WTOMC   SETA  1                   WTO ROUTECDE - MASTER CONSOLE
  1643. &WTOMCI  SETA  2                   WTO ROUTECDE - MASTER CONSOLE INFO
  1644. &WTOTAPE SETA  3                   WTO ROUTECDE - TAPE POOL
  1645. &WTODISK SETA  4                   WTO ROUTECDE - DISK POOL
  1646. &WTOTLIB SETA  5                   WTO ROUTECDE - TAPE LIBRARY
  1647. &WTODLIB SETA  6                   WTO ROUTECDE - DISK LIBRARY
  1648. &WTOUREC SETA  7                   WTO ROUTECDE - UNIT RECORD POOL
  1649. &WTOTPC  SETA  8                   WTO ROUTECDE - TELEPROCESSING
  1650. &WTOSSEC SETA  9                   WTO ROUTECDE - SYSTEM SECURITY
  1651. &WTOERR  SETA  10                  WTO ROUTECDE - ERROR LOG
  1652. &WTOPROG SETA  11                  WTO ROUTECDE - PROGRAMMER
  1653. &WTOEMUL SETA  12                  WTO ROUTECDE - EMULATION
  1654. &WTOURC1 SETA  13                  WTO ROUTECDE - USER CODE 1
  1655. &WTOURC2 SETA  14                  WTO ROUTECDE - USER CODE 2
  1656. &WTOURC3 SETA  15                  WTO ROUTECDE - USER CODE 3
  1657. &WTOFAIL SETA  1                   WTO DESC - SYSTEM FAILURE
  1658. &WTOIACT SETA  2                   WTO DESC - IMMEDIATE ACTION
  1659. &WTOEACT SETA  3                   WTO DESC - EVENTUAL ACTION
  1660. &WTOSTAT SETA  4                   WTO DESC - SYSTEM STATUS
  1661. &WTOCMDR SETA  5                   WTO DESC - COMMAND RESPONSE
  1662. &WTOJOB  SETA  6                   WTO DESC - JOB STATUS
  1663. &WTOAPPL SETA  7                   WTO DESC - APPLICATION PROGRAM
  1664. &WTOOUTL SETA  8                   WTO DESC - OUT-OF-LINE MESSAGE
  1665. &WTODISP SETA  9                   WTO DESC - DYNAMIC STATUS DISPLAYS
  1666. &WTOCRIT SETA  10                  WTO DESC - CRITICAL EVENTUAL ACTION
  1667. ./       ADD   LIST=ALL,NAME=CPARMVER
  1668. *
  1669. *  NIH/COMMON - NO VERSION-SPECIFIC ASSEMBLY PARAMETER VALUES
  1670. *
  1671. ./       ADD   LIST=ALL,NAME=CPOP
  1672.          MACRO
  1673. &L       CPOP  &R,&SIZE,&EXTRA=0
  1674.          AIF   ('&R' EQ '').SIZE
  1675. &L       LR    STKR,&R
  1676.          MEXIT
  1677. .*
  1678. .SIZE    ANOP
  1679.          AIF   ('&SIZE'(1,1) EQ '(').RSIZE
  1680. &L       SL    STKR,=A((&SIZE+&EXTRA+3)/4*4)
  1681.          CSAVGEN
  1682.          MEXIT
  1683. .*
  1684. .RSIZE   ANOP
  1685. &L       SLR   STKR,&SIZE
  1686.          AIF   ('&EXTRA' EQ '0').NEXTRA
  1687.          SI    STKR,&EXTRA
  1688. .NEXTRA  ANOP
  1689.          N     STKR,=XL4'FFFFFFFC'
  1690.          CSAVGEN
  1691.          MEND
  1692. ./       ADD   LIST=ALL,NAME=CPOPREG
  1693.          MACRO
  1694. &L       CPOPREG &R,&S
  1695.          GBLC  &CSVLINK(4)
  1696.          LCLC  &SAVLINK
  1697. .*
  1698. &SAVLINK SETC  '&CSVLINK(1)'
  1699. &CSVLINK(1) SETC ''
  1700. .*
  1701.          AIF   ('&S' EQ '').ONE
  1702. &L       CPOP  ,4*(&S+1-(&R)+16*(((&R)/(&S+1))/((&R)/(&S+1))))
  1703.          LM    &R,&S,0(STKR)
  1704. &CSVLINK(1) SETC '&SAVLINK'
  1705.          CSAVGEN
  1706.          MEXIT
  1707. .*
  1708. .ONE     ANOP
  1709. &L       CPOP  ,4
  1710.          L     &R,0(,STKR)
  1711. &CSVLINK(1) SETC '&SAVLINK'
  1712.          CSAVGEN
  1713.          MEND
  1714. ./       ADD   LIST=ALL,NAME=CPUSH
  1715.          MACRO
  1716. &L       CPUSH &R,&SIZE,&EXTRA=0
  1717.          LCLC  &LBL
  1718. &LBL     SETC  '&L'
  1719.          AIF   ('&R' EQ '').NR
  1720. &LBL     LR    &R,STKR
  1721. &LBL     SETC  ''
  1722. .NR      ANOP
  1723. .*
  1724.          AIF   ('&SIZE'(1,1) EQ '(').REG
  1725. &LBL     LA    STKR,(&SIZE+&EXTRA+3)/4*4(,STKR)
  1726.          CSAVGEN
  1727.          MEXIT
  1728. .*
  1729. .REG     ANOP
  1730. &LBL     LA    STKR,&EXTRA+3(&SIZE,STKR)
  1731.          AIF   ('&SIZE' NE '(0)' AND '&SIZE' NE '(R0)' AND             *
  1732.                '&SIZE' NE '(VR0)').NZREG
  1733.          AR    STKR,&SIZE
  1734. .NZREG   ANOP
  1735.          N     STKR,=XL4'FFFFFFFC'
  1736.          CSAVGEN
  1737.          MEND
  1738. ./       ADD   LIST=ALL,NAME=CPUSHREG
  1739.          MACRO
  1740. &L       CPUSHREG &R,&S
  1741.          AIF   ('&S' EQ '').ONE
  1742. &L       STM   &R,&S,0(STKR)
  1743.          CPUSH ,4*(&S+1-(&R)+16*(((&R)/(&S+1))/((&R)/(&S+1))))
  1744.          MEXIT
  1745. .*
  1746. .ONE     ANOP
  1747. &L       ST    &R,0(,STKR)
  1748.          CPUSH ,4
  1749.          MEND
  1750. ./       ADD   LIST=ALL,NAME=CREGS
  1751.          MACRO
  1752.          CREGS
  1753. *
  1754. *  REGISTER USAGE
  1755. *
  1756. VR0      EQU   0                       PARAMETER REGISTER
  1757. VR1      EQU   1                       PARAMETER REGISTER
  1758. XRA      EQU   2                       WORK REGISTER
  1759. XRB      EQU   3                       WORK REGISTER
  1760. XRC      EQU   4                       WORK REGISTER
  1761. XRD      EQU   5                       WORK REGISTER
  1762. XRE      EQU   6                       WORK REGISTER
  1763. XRF      EQU   7                       WORK REGISTER
  1764. XRG      EQU   8                       WORK REGISTER
  1765. RTNR     EQU   9                       RETURN REGISTER
  1766. BASER    EQU   10                      BASE REGISTER
  1767. WAR      EQU   11                      WORK AREA REGISTER
  1768. GCBR     EQU   12                      GLOBAL CONTROL BLOCK REGISTER
  1769. STKR     EQU   13                      STACK REGISTER
  1770. VRE      EQU   14                      PARAMETER REGISTER
  1771. VRF      EQU   15                      PARAMETER REGISTER
  1772. *
  1773. LOWR     EQU   XRA                     LOWEST REGISTER TO SAVE
  1774. HIGHR    EQU   WAR                     HIGHEST REGISTER TO SAVE
  1775.          MEND
  1776. ./       ADD   LIST=ALL,NAME=CSA
  1777.          MACRO
  1778. &L       CSA   &R,&S,&EQU=
  1779.          LCLA  &X
  1780.          LCLC  &LBL
  1781. .*
  1782. &LBL     SETC  '&L'
  1783.          AIF   ('&L' NE '' OR '&EQU' EQ '').NLBL
  1784. &LBL     SETC  'CSA&SYSNDX'
  1785. .NLBL    ANOP
  1786. .*
  1787. &LBL     DS    (&S+1-(&R)+16*(((&R)/(&S+1))/((&R)/(&S+1))))A
  1788. .*
  1789. &X       SETA  0-1
  1790. .LOOP    ANOP
  1791. &X       SETA  &X+2
  1792.          AIF   (&X GT N'&EQU).DONE
  1793. &EQU(&X) EQU   &LBL+(&EQU(&X+1)-(&R)+16*(((&R)/(&EQU(&X+1)+1))/((&R)/(&*
  1794.                EQU(&X+1)+1))))*4
  1795.          AGO   .LOOP
  1796. .*
  1797. .DONE    ANOP
  1798. .*
  1799.          MEND
  1800. ./       ADD   LIST=ALL,NAME=CSAVGEN
  1801.          MACRO
  1802. &L       CSAVGEN
  1803.          GBLC  &CSVLINK(4)
  1804.          AIF   ('&CSVLINK(1)' EQ '').NONE
  1805. &L       MVC   0(12,STKR),=XL12'00'
  1806.    SYSLST 4(STKR),NEW=&CSVLINK(1)&CSVLINK(2)&CSVLINK(3)&CSVLINK(4),OP=L
  1807.          MEXIT
  1808. .*
  1809. .NONE    ANOP
  1810. &L       SYSLBL
  1811.          MEND
  1812. ./       ADD   LIST=ALL,NAME=CSAVLINK
  1813.          MACRO
  1814. &L       CSAVLINK &SAVE
  1815.          GBLC  &CSVLINK(4)
  1816.          LCLA  &X,&Y
  1817. .*
  1818. &L       SYSLBL
  1819. .*
  1820. .LOOP    ANOP
  1821. &X       SETA  &X+1
  1822. &CSVLINK(&X) SETC ''
  1823. &Y       SETA  K'&SAVE-(&X-1)*8
  1824.          AIF   (&Y LE 0).NULL
  1825.          AIF   (&Y LE 8).SHORT
  1826. &Y       SETA  8
  1827. .SHORT   ANOP
  1828. &CSVLINK(&X) SETC '&SAVE'(1+(&X-1)*8,&Y)
  1829. .*
  1830. .NULL    ANOP
  1831.          AIF   (&X LT 4).LOOP
  1832.          MEND
  1833. ./       ADD   LIST=ALL,NAME=CSETUP
  1834.          MACRO
  1835. &L       CSETUP ®S=YES,&SETS=YES,&CBS=YES,&SCABBRS=YES,&CSECT=YES,  *
  1836.                &SYMDEL=YES,&KWR=NO,&MDC=NO,&NAT=NO,&SCT=NO,            *
  1837.                &CVT=NO,&DCB=NO,&DEB=NO,&UCB=NO,&DECB=NO,               *
  1838.                &TCB=NO,&CDE=NO,&PQE=NO,&RB=NO,&IQE=NO,&LPDE=NO,        *
  1839.                &ASCB=NO,&S99=NO,&ACB=NO,&RPL=NO,&SSOB=NO,&LRC=NO,      *
  1840.                &SDWA=NO,&JESCT=NO,&PSA=NO,&PCCA=NO,&TQE=NO,&LLE=NO,    *
  1841.                &ASXB=NO,&SMCA=NO,&JSCB=NO,&RIB=NO,&ACEE=NO,            *
  1842.                &R15=VRF,&R14=VRE,&R13=STKR,&BASER=BASER,               *
  1843.                &R1=VR1,&R0=VR0
  1844. .*
  1845.          COPY  CPARMGBL
  1846.          GBLC  &#R15,&#R14,&#R13,&#BASER,&#R1,&#R0
  1847.          GBLC  &SYSSPLV
  1848.          LCLA  &X,&Y
  1849. .*
  1850. .*  SET OS REGISTER NAMES
  1851. .*
  1852. &#R15    SETC  '&R15'
  1853. &#R14    SETC  '&R14'
  1854. &#R13    SETC  '&R13'
  1855. &#BASER  SETC  '&BASER'
  1856. &#R1     SETC  '&R1'
  1857. &#R0     SETC  '&R0'
  1858. .*
  1859. .*  CHECK MACRO PARAMETER VALUES
  1860. .*
  1861.          SYSKWT SETS,&SETS,(YES,NO),COND=NO
  1862.          SYSKWT SCABBRS,&SCABBRS,(YES,NO),COND=NO
  1863.          SYSKWT REGS,®S,(YES,NO,NEVER),COND=NO
  1864.          SYSKWT CBS,&CBS,(YES,NO,ALL),COND=NO
  1865.          SYSKWT CSECT,&CSECT,(YES,NO),COND=NO
  1866.          SYSKWT SYMDEL,&SYMDEL,(YES,NO),COND=NO
  1867.          SYSKWT MDC,&MDC,(YES,NO),COND=NO
  1868.          SYSKWT SCT,&SCT,(YES,NO,NEVER),COND=NO
  1869.          SYSKWT NAT,&NAT,(YES,NO),COND=NO
  1870.          SYSKWT ACB,&ACB,(YES,NO),COND=NO
  1871.          SYSKWT ACEE,&ACEE,(YES,NO),COND=NO
  1872.          SYSKWT ASCB,&ASCB,(YES,NO),COND=NO
  1873.          SYSKWT ASXB,&ASXB,(YES,NO),COND=NO
  1874.          SYSKWT CDE,&CDE,(YES,NO),COND=NO
  1875.          SYSKWT CVT,&CVT,(YES,NO),COND=NO
  1876.          SYSKWT DCB,&DCB,(YES,NO),COND=NO
  1877.          SYSKWT DEB,&DEB,(YES,NO),COND=NO
  1878.          SYSKWT DECB,&DECB,(YES,NO),COND=NO
  1879.          SYSKWT IQE,&IQE,(YES,NO),COND=NO
  1880.          SYSKWT JESCT,&JESCT,(YES,NO),COND=NO
  1881.          SYSKWT JSCB,&JSCB,(YES,NO),COND=NO
  1882.          SYSKWT LLE,&LLE,(YES,NO),COND=NO
  1883.          SYSKWT LPDE,&LPDE,(YES,NO),COND=NO
  1884.          SYSKWT LRC,&LRC,(YES,NO),COND=NO
  1885.          SYSKWT PCCA,&PCCA,(YES,NO),COND=NO
  1886.          SYSKWT PQE,&PQE,(YES,NO),COND=NO
  1887.          SYSKWT PSA,&PSA,(YES,NO),COND=NO
  1888.          SYSKWT RB,&RB,(YES,NO),COND=NO
  1889.          SYSKWT RPL,&RPL,(YES,NO),COND=NO
  1890.          SYSKWT SDWA,&SDWA,(YES,NO),COND=NO
  1891.          SYSKWT SMCA,&SMCA,(YES,NO),COND=NO
  1892.          SYSKWT SSOB,&SSOB,(YES,NO),COND=NO
  1893.          SYSKWT S99,&S99,(YES,NO),COND=NO
  1894.          SYSKWT TCB,&TCB,(YES,NO),COND=NO
  1895.          SYSKWT TQE,&TQE,(YES,NO),COND=NO
  1896.          SYSKWT UCB,&UCB,(YES,NO),COND=NO
  1897. .*
  1898. .*  ASSEMBLY PARAMETER VALUES
  1899. .*
  1900.          AIF   ('&SETS' EQ 'NO').NSETS
  1901.          COPY  CPARMSET
  1902.          COPY  CPARMALL
  1903.          COPY  CPARMVER
  1904. .*
  1905. .*  CHECK ASSEMBLY PARAMETER VALUES
  1906. .*
  1907.          COPY  CPARMRNG
  1908. .*
  1909. .*  COMPUTE LINE NUMBER VALUES
  1910. .*
  1911. &LNMIN   SETC  '0'
  1912. .*
  1913. &Y       SETA  1
  1914. &X       SETA  &LNDP
  1915. .LNLOOP  ANOP
  1916. &Y       SETA  &Y*10
  1917. &X       SETA  &X-1
  1918.          AIF   (&X GE 0).LNLOOP
  1919. &Y       SETA  &Y/10
  1920. &LN1     SETC  '&Y'
  1921. .*
  1922. &LNMAX   SETC  ''
  1923. &LNMAXZ  SETC  ''
  1924. &X       SETA  &LNIP+&LNDP
  1925. .LNMLOOP ANOP
  1926. &LNMAX   SETC  '&LNMAX.9'
  1927. &LNMAXZ  SETC  '&LNMAXZ.0'
  1928. &X       SETA  &X-1
  1929.          AIF   (&X GT 0).LNMLOOP
  1930. .*
  1931. &X       SETA  1
  1932. &Y       SETA  0
  1933. .LNBLOOP ANOP
  1934. &X       SETA  &X*2
  1935. &Y       SETA  &Y+1
  1936.          AIF   (&LNMAX GE &X).LNBLOOP
  1937. &LNBITS  SETC  '&Y'
  1938. .*
  1939.          AIF   (&Y EQ &Y/4*4 AND &Y GT 4).LNNM4
  1940. &LNMASK  SETC  '0137'(1+&Y-&Y/4*4,1)
  1941. .LNNM4   ANOP
  1942.          AIF   (&Y LT 4).LNBLT4
  1943. &LNMASK  SETC  '&LNMASK'.'FFFFFFFF'(1,&Y/4)
  1944. .LNBLT4  ANOP
  1945. .*
  1946. .*  PERFORM RACF CHECK
  1947. .*
  1948.          AIF   ('&RACF' NE 'YES').NRACF
  1949.          AIF   ('&OS' EQ 'MVS' OR '&OS' EQ 'XA').NRACF
  1950. &RACF    SETC  'NO'
  1951. .NRACF   ANOP
  1952. .*
  1953. .*  PERFORM XA CHECK
  1954. .*
  1955.          AIF   ('&OS' NE 'XA').NXA
  1956. &CPU     SETC  '370BS'
  1957. .NXA     ANOP
  1958. .*
  1959. .*  PRINT ASSEMBLY PARAMETER VALUES
  1960. .*
  1961.          COPY  CPARMPRT
  1962. .*
  1963. .NSETS   ANOP
  1964. .*
  1965. .*  SET PROPER SPLEVEL FOR MVS/370 AND MVS/XA
  1966. .*
  1967.          AIF   ('&OS' EQ 'XA').SPLXA
  1968.          AIF   ('&OS' NE 'MVS').SPLDONE
  1969.          SPLEVEL SET=1                 REQUEST MVS/370 MACRO EXPANSIONS
  1970.          AGO   .SPLDONE
  1971. .*
  1972. .SPLXA   ANOP
  1973.          SPLEVEL SET=2                 REQUEST MVS/XA MACRO EXPANSIONS
  1974. .SPLDONE ANOP
  1975.          SPLEVEL TEST
  1976.          MNOTE *,'SPLEVEL=&SYSSPLV'
  1977. .*
  1978. .*  SCANNER ABBREVIATIONS
  1979. .*
  1980.          AIF   ('&SCABBRS' EQ 'NO').NSCABBR
  1981.          SCABBRS
  1982. .NSCABBR ANOP
  1983. .*
  1984. .*  CONTROL BLOCKS
  1985. .*
  1986.          AIF   ('&CBS' EQ 'NO').NCBS
  1987.          AIF   ('&DBC' EQ 'NO' OR '&SYMDEL' EQ 'NO').NSYMDEL
  1988. SYMDEL   DSECT
  1989. .NSYMDEL ANOP
  1990. .*
  1991. .*  KWR
  1992. .*
  1993.          AIF   ('&KWR' EQ 'NO' AND '&CBS' NE 'ALL').NKWR
  1994.          TITLE 'KWR - KEYWORD RECORD'
  1995. KWR      DSECT
  1996.          KWR2
  1997. .NKWR    ANOP
  1998. .*
  1999. .*  MDC
  2000. .*
  2001.          AIF   ('&MDC' EQ 'NO' AND '&CBS' NE 'ALL').NMDC
  2002.          TITLE 'MDC - MACHINE DEPENDENT CELLS'
  2003. MDC      DSECT
  2004.          MDC
  2005. .NMDC    ANOP
  2006. .*
  2007. .*  NAT
  2008. .*
  2009.          AIF   ('&NAT' EQ 'NO' AND '&CBS' NE 'ALL').NNAT
  2010.          TITLE 'NAT - NUCLEUS ADDRESS TABLE'
  2011. NAT      DSECT
  2012.          NAT
  2013. .NNAT    ANOP
  2014. .*
  2015. .*  SCT
  2016. .*
  2017.  AIF (('&SCT' EQ 'NEVER') OR ('&SCT' EQ 'NO' AND '&CBS' NE 'ALL')).NSCT
  2018.          TITLE 'SCT - SCAN CONTROL TABLE'
  2019. SCT      DSECT
  2020.          SCT
  2021. .NSCT    ANOP
  2022. .*
  2023. .*  ACB
  2024. .*
  2025.          AIF   ('&ACB' EQ 'NO' AND '&CBS' NE 'ALL').NACB
  2026.          AIF   ('&OS' EQ 'MVT' OR '&OS' EQ 'MFT').NACB
  2027.          TITLE 'ACB - OS ACCESS METHOD CONTROL BLOCK'
  2028.          IFGACB ,
  2029. *
  2030. ACB      EQU   IFGACB
  2031. .NACB    ANOP
  2032. .*
  2033. .*  ACEE
  2034. .*
  2035.          AIF   ('&ACEE' EQ 'NO' AND '&CBS' NE 'ALL').NACEE
  2036.          AIF   ('&RACF' EQ 'NO').NACEE
  2037.          TITLE 'ACEE - RACF ACCESSOR ENVIRONMENT ELEMENT'
  2038.          IHAACEE
  2039. .NACEE   ANOP
  2040. .*
  2041. .*  ASCB
  2042. .*
  2043.          AIF   ('&ASCB' EQ 'NO' AND '&CBS' NE 'ALL').NASCB
  2044.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NASCB
  2045.          TITLE 'ASCB - OS ADDRESS SPACE CONTROL BLOCK'
  2046.          IHAASCB ,
  2047. .NASCB   ANOP
  2048. .*
  2049. .*  ASXB
  2050. .*
  2051.          AIF   ('&ASXB' EQ 'NO' AND '&CBS' NE 'ALL').NASXB
  2052.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NASXB
  2053.          TITLE 'ASXB - OS ADDRESS SPACE EXTENSION BLOCK'
  2054.          IHAASXB ,
  2055. .NASXB   ANOP
  2056. .*
  2057. .*  CDE
  2058. .*
  2059.          AIF   ('&CDE' EQ 'NO' AND '&CBS' NE 'ALL').NCDE
  2060.          TITLE 'OS CONTENTS DIRECTORY ENTRY'
  2061.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IHACDE
  2062. CDE      DSECT
  2063.          CDEMVT
  2064.          AGO   .NCDE
  2065. .*
  2066. .IHACDE  ANOP
  2067.          IHACDE ,
  2068. *
  2069. CDE      EQU   CDENTRY
  2070. .NCDE    ANOP
  2071. .*
  2072. .*  CVT
  2073. .*
  2074.          AIF   ('&CVT' EQ 'NO' AND '&CBS' NE 'ALL').NCVT
  2075.          TITLE 'CVT - OS COMMUNICATIONS VECTOR TABLE'
  2076.          AIF   ('&OS' EQ 'MVS' OR '&OS' EQ 'XA').VSCVT
  2077.          AIF   ('&OS' EQ 'SVS' OR '&OS' EQ 'VS1').VSCVT
  2078. CVT      DSECT
  2079.          CVT
  2080.          AGO   .NCVT
  2081. .*
  2082. .VSCVT   ANOP
  2083.          CVT   DSECT=YES,LIST=YES
  2084. .NCVT    ANOP
  2085. .*
  2086. .*  DCB
  2087. .*
  2088.          AIF   ('&DCB' EQ 'NO' AND '&CBS' NE 'ALL').NDCB
  2089.          TITLE 'DCBD - OS DATA CONTROL BLOCK DSECT'
  2090.          DCBD  DSORG=(PS,PO,DA),DEVD=DA
  2091. *
  2092. DCB      EQU   IHADCB
  2093. .NDCB    ANOP
  2094. .*
  2095. .*  DEB
  2096. .*
  2097.          AIF   ('&DEB' EQ 'NO' AND '&CBS' NE 'ALL').NDEB
  2098.          TITLE 'DEB - OS DATA EXTENT BLOCK'
  2099.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MFT').VSDEB
  2100. DEB      DSECT
  2101.          DEBMVT
  2102.          AGO   .NDEB
  2103. .*
  2104. .VSDEB   ANOP
  2105.          IEZDEB LIST=YES
  2106. .NDEB    ANOP
  2107. .*
  2108. .*  DECB
  2109. .*
  2110.          AIF   ('&DECB' EQ 'NO' AND '&CBS' NE 'ALL').NDECB
  2111.          TITLE 'DECB - OS DATA EVENT CONTROL BLOCK'
  2112. DECB     DSECT
  2113.          DECBMVT
  2114. .NDECB   ANOP
  2115. .*
  2116. .*  IQE
  2117. .*
  2118.          AIF   ('&IQE' EQ 'NO' AND '&CBS' NE 'ALL').NIQE
  2119.          TITLE 'IQE - OS INTERRUPTION QUEUE ELEMENT'
  2120.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IHAIQE
  2121. IQE      DSECT
  2122.          IQEMVT
  2123.          AGO   .NIQE
  2124. .*
  2125. .IHAIQE  ANOP
  2126.          IHAIQE ,
  2127. IQE      EQU   IQESECT
  2128. .NIQE    ANOP
  2129. .*
  2130. .*  JESCT
  2131. .*
  2132.          AIF   ('&JESCT' EQ 'NO' AND '&CBS' NE 'ALL').NJESCT
  2133.          AIF   ('&OS' EQ 'MVT' OR '&OS' EQ 'MFT').NJESCT
  2134.          TITLE 'JESCT - OS JES COMMUNICATION TABLE'
  2135.          IEFJESCT ,
  2136. .NJESCT  ANOP
  2137. .*
  2138. .*  JSCB
  2139. .*
  2140.          AIF   ('&JSCB' EQ 'NO' AND '&CBS' NE 'ALL').NJSCB
  2141.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NJSCB
  2142.          TITLE 'JSCB - OS JOB STEP CONTROL BLOCK'
  2143.          IEZJSCB ,
  2144. JSCB     EQU   IEZJSCB
  2145. .NJSCB   ANOP
  2146. .*
  2147. .*  LLE
  2148. .*
  2149.          AIF   ('&LLE' EQ 'NO' AND '&CBS' NE 'ALL').NLLE
  2150.          TITLE 'LLE - OS LOAD LIST ELEMENT'
  2151.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IHALLE
  2152. LLE      DSECT
  2153.          LLEMVT
  2154.          AGO   .NLLE
  2155. .*
  2156. .IHALLE  ANOP
  2157.          IHALLE ,
  2158. .NLLE    ANOP
  2159. .*
  2160. .*  LPDE
  2161. .*
  2162.          AIF   ('&LPDE' EQ 'NO' AND '&CBS' NE 'ALL').NLPDE
  2163.          AIF   ('&OS' NE 'XA' AND '&OS' NE 'MVS').NLPDE
  2164.          TITLE 'LPDE - OS LINK PACK DIRECTORY ELEMENT'
  2165.          IHALPDE ,
  2166. LPDESIZE EQU   *-LPDE
  2167. .NLPDE   ANOP
  2168. .*
  2169. .*  LRC
  2170. .*
  2171.          AIF   ('&LRC' EQ 'NO' AND '&CBS' NE 'ALL').NLRC
  2172.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NLRC
  2173. *
  2174. &L       CSECT
  2175.          $LRC  DOC=YES
  2176. *
  2177. LRC      EQU   LRCDSECT
  2178. .NLRC    ANOP
  2179. .*
  2180. .*  PCCA
  2181. .*
  2182.          AIF   ('&PCCA' EQ 'NO' AND '&CBS' NE 'ALL').NPCCA
  2183.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NPCCA
  2184.          TITLE 'PCCA - OS PHYSICAL CONFIGURATION COMMUNICATION AREA'
  2185.          IHAPCCA ,
  2186. .NPCCA   ANOP
  2187. .*
  2188. .*  PQE
  2189. .*
  2190.          AIF   ('&PQE' EQ 'NO' AND '&CBS' NE 'ALL').NPQE
  2191.          TITLE 'OS PARTITION QUEUE ELEMENT'
  2192.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IHAPQE
  2193. PQE      DSECT
  2194.          PQEMVT
  2195.          AGO   .NPQE
  2196. .*
  2197. .IHAPQE  ANOP
  2198.          IHAPQE ,
  2199. *
  2200. PQE      EQU   PQESECT
  2201. .NPQE    ANOP
  2202. .*
  2203. .*  PSA
  2204. .*
  2205.          AIF   ('&PSA' EQ 'NO' AND '&CBS' NE 'ALL').NPSA
  2206.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NPSA
  2207.          TITLE 'PSA - OS PREFIX STORAGE AREA'
  2208.          IHAPSA ,
  2209. .NPSA    ANOP
  2210. .*
  2211. .*  RB
  2212. .*
  2213.          AIF   ('&RB' EQ 'NO' AND '&CBS' NE 'ALL').NRB
  2214.          TITLE 'OS REQUEST BLOCK'
  2215.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MVT').IHARB
  2216. RB       DSECT
  2217.          RBMVT
  2218.          AGO   .NRB
  2219. .*
  2220. .IHARB   ANOP
  2221.          AIF   ('&OS' EQ 'VS1').IHARB1
  2222.          IHARB ,
  2223. *
  2224. RB       EQU   RBBASIC
  2225.          AGO   .NRB
  2226. .*
  2227. .IHARB1  ANOP
  2228.          IHARB SYS=AOS1                VS1 RB
  2229. *
  2230. RB       EQU   RBBASIC
  2231. .NRB     ANOP
  2232. .*
  2233. .*  RIB
  2234. .*
  2235.          AIF   ('&RIB' EQ 'NO' AND '&CBS' NE 'ALL').NRIB
  2236.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NRIB
  2237.          TITLE 'RIB - OS RESOURCE INFORMATION BLOCK'
  2238.          ISGRIB ,
  2239. .NRIB    ANOP
  2240. .*
  2241. .*  RPL
  2242. .*
  2243.          AIF   ('&RPL' EQ 'NO' AND '&CBS' NE 'ALL').NRPL
  2244.          AIF   ('&OS' EQ 'MVT' OR '&OS' EQ 'MFT').NRPL
  2245.          TITLE 'RPL - OS REQUEST PARAMETER LIST'
  2246.          IFGRPL ,
  2247. *
  2248. RPL      EQU   IFGRPL
  2249.          EJECT
  2250.          IDARMRCD ,
  2251.          AIF   ('&JES' NE 'NIHJES2A').NRPL
  2252.          EJECT
  2253.          JESNRPL
  2254. .NRPL    ANOP
  2255. .*
  2256. .*  SDWA
  2257. .*
  2258.          AIF   ('&SDWA' EQ 'NO' AND '&CBS' NE 'ALL').NSDWA
  2259.          AIF   ('&OS' EQ 'MVT' OR '&OS' EQ 'MFT').NSDWA
  2260.          TITLE 'SDWA - OS SYSTEM DIAGNOSTIC WORKAREA'
  2261.          IHASDWA ,
  2262. .NSDWA   ANOP
  2263. .*
  2264. .*  SMCA
  2265. .*
  2266.          AIF   ('&SMCA' EQ 'NO' AND '&CBS' NE 'ALL').NSMCA
  2267.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NSMCA
  2268.          TITLE 'SMCA - OS SYSTEM MANAGEMENT FACILITIES CONTROL AREA'
  2269.          IEESMCA ,
  2270. SMCA     EQU   SMCABASE
  2271. .NSMCA   ANOP
  2272. .*
  2273. .*  SSOB
  2274. .*
  2275.          AIF   ('&SSOB' EQ 'NO' AND '&CBS' NE 'ALL').NSSOB
  2276.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NSSOB
  2277.          TITLE 'SSOB - OS SUBSYSTEM OPTIONS BLOCK'
  2278.          IEFJSSOB (SO,CS,AL,DA,US),CONTIG=YES
  2279.          AIF   ('&JES' NE 'NIHJES2A').NSSOB
  2280.          EJECT
  2281.          JESNSSOB (SO,JC,FC)
  2282. .NSSOB   ANOP
  2283. .*
  2284. .*  S99
  2285. .*
  2286.          AIF   ('&S99' EQ 'NO' AND '&CBS' NE 'ALL').NS99
  2287.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NS99
  2288.          TITLE 'OS DYNAMIC ALLOCATION DEFINITIONS'
  2289. S99      DSECT
  2290.          IEFZB4D0 ,
  2291.          EJECT
  2292.          IEFZB4D2 ,
  2293. .NS99    ANOP
  2294. .*
  2295. .*  TCB
  2296. .*
  2297.          AIF   ('&TCB' EQ 'NO' AND '&CBS' NE 'ALL').NTCB
  2298.          TITLE 'TCB - OS TASK CONTROL BLOCK'
  2299.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IKJTCB
  2300. TCB      DSECT
  2301.          TCBMVT
  2302.          AGO   .NTCB
  2303. .*
  2304. .IKJTCB  ANOP
  2305.          AIF   ('&OS' EQ 'VS1').IKJTCB1
  2306.          IKJTCB LIST=YES
  2307.          AGO   .NTCB
  2308. .*
  2309. .IKJTCB1 ANOP
  2310.          IKJTCB SYS=AOS1,LIST=YES      VS1 TCB
  2311. .NTCB    ANOP
  2312. .*
  2313. .*  TQE
  2314. .*
  2315.          AIF   ('&TQE' EQ 'NO' AND '&CBS' NE 'ALL').NTQE
  2316.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NTQE
  2317.          TITLE 'TQE - TIMER QUEUE ELEMENT'
  2318.          IHATQE ,
  2319. .NTQE    ANOP
  2320. .*
  2321. .*  UCB
  2322. .*
  2323.          AIF   ('&UCB' EQ 'NO' AND '&CBS' NE 'ALL').NUCB
  2324.          TITLE 'UCB - OS UNIT CONTROL BLOCK'
  2325.          AIF   ('&OS' EQ 'MVS' OR '&OS' EQ 'XA').UCBMVS
  2326. UCB      DSECT
  2327.          IEFUCBOB
  2328.          AGO   .NUCB
  2329. .*
  2330. .UCBMVS  ANOP
  2331. UCB      DSECT
  2332.          IEFUCBOB LIST=YES
  2333. .NUCB    ANOP
  2334. .*
  2335.          AIF   ('&DBC' EQ 'NO' OR '&SYMDEL' EQ 'NO').NCBS
  2336. SYMNODEL DSECT
  2337. .NCBS    ANOP
  2338. .*
  2339. .*  REGISTERS
  2340. .*
  2341.          AIF   (('&CSECT' EQ 'NO') AND                                 *
  2342.                (('®S' EQ 'NO') OR ('®S' EQ 'NEVER'))).NTITLE
  2343.          TITLE 'REGISTER DEFINITIONS'
  2344. .NTITLE  ANOP
  2345.          AIF   ('&CSECT' EQ 'NO').NCSECT
  2346. &L       CSECT
  2347. .NCSECT  ANOP
  2348. .*
  2349.          AIF   ('®S' EQ 'NEVER').NREGS
  2350.          AIF   (('®S' EQ 'NO') AND (('&CBS' EQ 'NO')                *
  2351.                OR ('&SCT' EQ 'NEVER')                                  *
  2352.                OR (('&SCT' EQ 'NO') AND ('&CBS' NE 'ALL')))).NREGS
  2353.          CREGS
  2354. .NREGS   ANOP
  2355.          MEND
  2356. ./       ADD   LIST=ALL,NAME=CSPOST
  2357.          MACRO
  2358. &L       CSPOST &ECB,&PC
  2359.          GBLC  &OS
  2360. .*
  2361. &L       SYSLR VR1,&ECB,ERR='ECB REQUIRED'
  2362.          AIF   ('&OS' EQ 'MVS' OR '&OS' EQ 'XA').VSPOST
  2363.          SYSLR VR0,&PC
  2364.          POST  (1),(0)
  2365.          MEXIT
  2366. .*
  2367. .VSPOST  ANOP
  2368.          AIF   ('&PC' EQ '' OR '&PC' EQ '0').ZPC
  2369.          SYSLR VR0,&PC
  2370.          O     VR0,=XL4'40000000'
  2371.          AGO   .POST
  2372. .*
  2373. .ZPC     ANOP
  2374.          L     VR0,=XL4'40000000'
  2375. .POST    ANOP
  2376.          L     VRF,0(,VR1)
  2377. PST&SYSNDX.A LTR VRF,VRF
  2378.          BM    PST&SYSNDX.B
  2379.          CS    VRF,VR0,0(VR1)
  2380.          BNE   PST&SYSNDX.A
  2381.          B     PST&SYSNDX.C
  2382. PST&SYSNDX.B POST (1),(0)
  2383. PST&SYSNDX.C DS 0H
  2384.          MEND
  2385. ./       ADD   LIST=ALL,NAME=CVBTA
  2386.          MACRO
  2387. &L       CVBTA &LOC,&LEN,&WORD
  2388. &L       SYSLR VRF,&WORD,OP=L,ERR='BINARY DATA REQUIRED'
  2389.          SYSLR VR0,&LEN
  2390.          SYSLR VR1,&LOC,ERR='LOCATION OF DECIMAL AREA REQUIRED'
  2391.          OSCALL CVBTA,VRF=(VRF)
  2392.          MEND
  2393. ./       ADD   LIST=ALL,NAME=CVBTD
  2394.          MACRO
  2395. &L       CVBTD &LOC,&LEN,&WORD
  2396. &L       SYSLR VRF,&WORD,OP=L,ERR='BINARY DATA REQUIRED'
  2397.          SYSLR VR0,&LEN
  2398.          SYSLR VR1,&LOC,ERR='LOCATION OF DECIMAL AREA REQUIRED'
  2399.          OSCALL CVBTD,VRF=(VRF)
  2400.          MEND
  2401. ./       ADD   LIST=ALL,NAME=CVBTR
  2402.          MACRO
  2403. &L       CVBTR &LOC,&LEN,&WORD
  2404. &L       SYSLR VRF,&WORD,OP=L,ERR='BINARY DATA REQUIRED'
  2405.          SYSLR VR0,&LEN
  2406.          SYSLR VR1,&LOC,ERR='LOCATION OF DECIMAL AREA REQUIRED'
  2407.          OSCALL CVBTR,VRF=(VRF)
  2408.          MEND
  2409. ./       ADD   LIST=ALL,NAME=CVBTX
  2410.          MACRO
  2411. &L       CVBTX &LOC,&LEN,&BIN
  2412. &L       SYSLR VRF,&BIN,ERR='ADDRESS OF BINARY DATA REQUIRED'
  2413.          SYSLR VR0,&LEN,ERR='LENGTH OF HEX AREA REQUIRED'
  2414.          SYSLR VR1,&LOC,ERR='LOCATION OF HEX AREA REQUIRED'
  2415.          OSCALL CVBTX,VRF=(VRF)
  2416.          MEND
  2417. ./       ADD   LIST=ALL,NAME=CVBT$
  2418.          MACRO
  2419. &L       CVBT$   &LOC,&LEN,&WORD
  2420. &L       SYSLR VRF,&WORD,OP=L,ERR='BINARY DATA REQUIRED'
  2421.          SYSLR VR0,&LEN
  2422.          SYSLR VR1,&LOC,ERR='LOCATION OF RESULT AREA REQUIRED'
  2423.          OSCALL CVBT$,VRF=(VRF)
  2424.          MEND
  2425. ./       ADD   LIST=ALL,NAME=CVDATE
  2426.          MACRO
  2427. &L       CVDATE &LOC,&DATE,&WEEKDAY=
  2428.          SYSKWT WEEKDAY,&WEEKDAY,(YES,NO)
  2429. &L    SYSLR VR1,&LOC,TYPE=&WEEKDAY,SELECT=(YES),ERR='LOCATION REQUIRED'
  2430.          SYSLR VR0,&DATE,OP=L,ERR='DATE REQUIRED'
  2431.          OSCALL CVDATE
  2432.          MEND
  2433. ./       ADD   LIST=ALL,NAME=CVDTB
  2434.          MACRO
  2435. &L       CVDTB &LOC,&LEN,&EXACT=
  2436.          SYSKWT EXACT,&EXACT,NO
  2437. &L       SYSLR VR1,&LOC,TYPE=&EXACT,ERR='LOCATION REQUIRED'
  2438.          SYSLR VR0,&LEN,ERR='LENGTH REQUIRED'
  2439.          OSCALL CVDTB
  2440.          MEND
  2441. ./       ADD   LIST=ALL,NAME=CVTIME
  2442.          MACRO
  2443. &L       CVTIME &LOC,&TIME,&M=
  2444.          SYSKWT AMPM,&M,YES
  2445. &L       SYSLR VR1,&LOC,TYPE=&M,ERR='LOCATION REQUIRED'
  2446.          SYSLR VR0,&TIME,OP=L,ERR='TIME REQUIRED'
  2447.          OSCALL CVTIME
  2448.          MEND
  2449. ./       ADD   LIST=ALL,NAME=CVTIM128
  2450.          MACRO
  2451. &L       CVTIM128 &TIME
  2452. &L       SYSLR VR0,&TIME,OP=L,ERR='TIME REQUIRED'
  2453.          OSCALL CVTIM128
  2454.          MEND
  2455. ./       ADD   LIST=ALL,NAME=CVXTB
  2456.          MACRO
  2457. &L       CVXTB &LOC,&LEN,&BIN
  2458. &L       SYSLR VR1,&LOC,ERR='LOCATION OF HEX STRING REQUIRED'
  2459.          SYSLR VR0,&LEN,ERR='LENGTH OF HEX STRING REQUIRED'
  2460.          SYSLR VRF,&BIN,ERR='LOCATION FOR BINARY RESULT REQUIRED'
  2461.          OSCALL CVXTB,VRF=(VRF)
  2462.          MEND
  2463. ./       ADD   LIST=ALL,NAME=DALLIST
  2464. ALP;
  2465.  
  2466. MACRO &&L: DALLIST &&TYPE,&&VERB,&&ERROR=,&&INFO=,&&FLAGS1=,_
  2467.                    &&FLAGS2=,&&MF=,&&SVC=,&&INIT=;
  2468.  
  2469.    GBLC &&DALMF,&&DALPL,&&DALLBL(25),&&DALEND,&&DALLEN,&&DALPTR;
  2470.    GBLC &&DALINIT;
  2471.    GBLA &&DALNUM;
  2472.    GBLB &&DALSW;
  2473.    GBLC &&OS;
  2474.  
  2475.    LCLA &&X,&&Y;
  2476.    LCLC &&STORE,&&LOAD,&&LQ;
  2477.  
  2478.    &&LQ: SETC 'L''';
  2479.  
  2480.    SYSKWT MF,&&MF(1),(L,E,R),COND=NO;
  2481.    SYSKWT SVC,&&SVC,(YES,NO),COND=NO;
  2482.    SYSKWT INIT,&&INIT,(YES,NO),COND=NO;
  2483.  
  2484.    ASM CASE '&TYPE';
  2485.       'BEGIN': BEGIN
  2486.          ASM IF ('&OS' NE 'MVS' AND '&OS' NE 'XA')
  2487.          THEN MNOTE 12,'DALLIST VALID ONLY FOR &&OS=MVS OR &&OS=XA';
  2488.          ASM IF (&&DALSW) THEN MNOTE 12,'MISSING DALLIST END';
  2489.          &&DALSW: SETB 1;  % SET BEGIN SWITCH
  2490.          &&DALMF: SETC '&MF(1)';  % SAVE MF VALUE
  2491.          &&DALPL: SETC '&MF(2)';
  2492.          &&DALINIT: SETC '&INIT';
  2493.          &&DALLEN: SETC '24';  % SET INITIAL LENGTH
  2494.          &&DALPTR: SETC 'DALP&@';
  2495.          &&DALNUM: SETA 0;
  2496.          ASM CASE '&MF(1)';
  2497.             '','L': BEGIN
  2498.                ASM CASE '&MF(1)';
  2499.                   'L': <&&L: DS 0F>;
  2500.                   '': BEGIN
  2501.                      &&DALEND: SETC 'DALE&@';  % END SYMBOL
  2502.                      &&L: GOTO &&DALEND;
  2503.                      &&DALPL: SETC 'DALA&@';
  2504.                      &&DALPL: DS 0F;
  2505.                      END;
  2506.                   ENDCASE;
  2507.                DC A(X'80000000'+*+4);  % PARM LIST
  2508.                DC AL1(20,&&VERB);
  2509.                ASM IF ('&FLAGS1(1)' EQ '') THEN DC AL1(0)
  2510.                ELSE DC AL1(&&FLAGS1(1));
  2511.                ASM IF ('&FLAGS1(2)' EQ '') THEN DC AL1(0)
  2512.                ELSE DC AL1(&&FLAGS1(2));
  2513.                &&ERROR: DC AL2(0);
  2514.                &&INFO: DC AL2(0);
  2515.                DC A(&&DALPTR);
  2516.                DC A(0);
  2517.                ASM IF ('&FLAGS2(1)' EQ '') THEN DC AL1(0)
  2518.                ELSE DC AL1(&&FLAGS2(1));
  2519.                ASM IF ('&FLAGS2(2)' EQ '') THEN DC AL1(0)
  2520.                ELSE DC AL1(&&FLAGS2(2));
  2521.                ASM IF ('&FLAGS2(3)' EQ '') THEN DC AL1(0)
  2522.                ELSE DC AL1(&&FLAGS2(3));
  2523.                ASM IF ('&FLAGS2(4)' EQ '') THEN DC AL1(0)
  2524.                ELSE DC AL1(&&FLAGS2(4));
  2525.                END;
  2526.             'E': BEGIN
  2527.                &&L: SYSLBL;
  2528.                ASM IF ('&DALINIT' NE 'NO') THEN BEGIN
  2529.                   SYSLST &&MF(2),NEW=4+&&MF(2);
  2530.                   OI &&MF(2),X'80';
  2531.                   MZC 4+&&MF(2),20;
  2532.                   MVI 4+&&MF(2),20;
  2533.                   SYSLST 12+&&MF(2),NEW=&&DALPTR;
  2534.                   ASM IF ('&VERB' EQ '')
  2535.                   THEN MNOTE 12,'VERB REQUIRED WITH MF=E AND INIT=YES';
  2536.                   END;
  2537.                ASM IF ('&VERB' NE '')
  2538.                THEN SYSLST 5+&&MF(2),NEW=&&VERB,STORE=STC;
  2539.                ASM IF ('&FLAGS1(1)' NE '')
  2540.                THEN SYSLST 6+&&MF(2),NEW=&&FLAGS1(1),STORE=STC;
  2541.                ASM IF ('&FLAGS1(2)' NE '')
  2542.                THEN SYSLST 7+&&MF(2),NEW=&&FLAGS1(2),STORE=STC;
  2543.                ASM IF ('&FLAGS2(1)' NE '')
  2544.                THEN SYSLST 20+&&MF(2),NEW=&&FLAGS2(1),STORE=STC;
  2545.                ASM IF ('&FLAGS2(2)' NE '')
  2546.                THEN SYSLST 21+&&MF(2),NEW=&&FLAGS2(2),STORE=STC;
  2547.                ASM IF ('&FLAGS2(3)' NE '')
  2548.                THEN SYSLST 22+&&MF(2),NEW=&&FLAGS2(3),STORE=STC;
  2549.                ASM IF ('&FLAGS2(4)' NE '')
  2550.                THEN SYSLST 23+&&MF(2),NEW=&&FLAGS2(4),STORE=STC;
  2551.                END;
  2552.             'R': BEGIN
  2553.                &&L: SYSLBL;
  2554.                END;
  2555.             ENDCASE ELSE;
  2556.          END;
  2557.       'TEXT': BEGIN
  2558.          ASM IF (NOT &&DALSW) THEN BEGIN
  2559.             MNOTE 12,'NO CORRESPONDING DALLIST BEGIN';
  2560.             &&L: SYSLBL;
  2561.             MEXIT;
  2562.             END;
  2563.          &&DALNUM: SETA &&DALNUM+1;
  2564.          BAL;
  2565. &DALLBL(&DALNUM) SETC 'DALT&@'
  2566. ALP;
  2567.          ASM CASE '&DALMF';
  2568.             '','L': BEGIN
  2569.                DALT&&@: DS 0X;
  2570.                &&X: SETA N'&&SYSLIST-2;
  2571.                &&L: DC AL2(&&VERB,&&X);
  2572.                ASM FOR &&X FROM 3 TO N'&&SYSLIST DO BEGIN
  2573.                   &&Y: SETA &&X-2;
  2574.                   ASM IF ('&SYSLIST(&X,2)' NE '') THEN BEGIN
  2575.                      ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2576.                         DC AL2(&&SYSLIST(&&X,2)),&&SYSLIST(&&X,1);
  2577.                         END
  2578.                      ELSE BEGIN
  2579.                        DC AL2(&&SYSLIST(&&X,2)),XL(&&SYSLIST(&&X,2))'0';
  2580.                         END;
  2581.                      END
  2582.                   ELSE BEGIN
  2583.                      DC AL2(L'DAC&&Y&&@);
  2584.                      DAC&&Y&&@: DC &&SYSLIST(&&X,1);
  2585.                      END;
  2586.                   END;
  2587.                END;
  2588.             'E': BEGIN
  2589.                &&L: SYSLBL;
  2590.                ASM IF ('&MF' NE 'L' AND '&DALINIT' NE 'NO') THEN BEGIN
  2591.                   SYSLST &&DALLEN+&&DALPL,NEW=&&VERB,STORE=STOREH;
  2592.                   &&X: SETA N'&&SYSLIST-2;
  2593.                   SYSLST &&DALLEN+2+&&DALPL,NEW=&&X,STORE=STOREH;
  2594.                   END;
  2595.                DALT&&@: EQU &&DALLEN+4;
  2596.                &&DALLEN: SETC 'DALT&@';
  2597.                ASM FOR &&X FROM 3 TO N'&&SYSLIST DO BEGIN
  2598.                   &&Y: SETA &&X-2;
  2599.                   ASM IF ('&MF' NE 'L') THEN BEGIN
  2600.                      ASM IF ('&SYSLIST(&X,3)' EQ '') THEN BEGIN
  2601.                         ASM IF ('&DALINIT' NE 'NO')
  2602.                         THEN SYSLST &&DALLEN+&&DALPL,_
  2603.                                     NEW=&&SYSLIST(&&X,2),STORE=STOREH;
  2604.                         ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2605.                            DALLISTM &&DALLEN+2+&&DALPL,_
  2606.                            &&SYSLIST(&&X,1),&&SYSLIST(&&X,2);
  2607.                            END;
  2608.                         END
  2609.                      ELSE BEGIN
  2610.                         ASM IF ('&SYSLIST(&X,3)'(1,1) NE '''')
  2611.                         THEN BEGIN
  2612.                            SYSLST &&DALLEN+&&DALPL,_
  2613.                            NEW=&&SYSLIST(&&X,3),STORE=STOREH;
  2614.                            ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2615.                               DALLISTM &&DALLEN+2+&&DALPL,_
  2616.                               &&SYSLIST(&&X,1),&&SYSLIST(&&X,3);
  2617.                               END;
  2618.                            END
  2619.                         ELSE BEGIN
  2620.                            &&STORE: SETC '&SYSLIST(&X,3)'(2,_
  2621.                                       K'&&SYSLIST(&&X,3)-2);
  2622.                            ASM CASE '&STORE';
  2623.                               'STC','STOREB': <&&Y: SETA 1>;
  2624.                               'STH','STOREH','STORELH': <&&Y: SETA 2>;
  2625.                               'STOREP': <&&Y: SETA 3>;
  2626.                               'ST','STOREF','STORELF': <&&Y: SETA 4>;
  2627.                               ENDCASE
  2628.                            ELSE BEGIN
  2629.                               MNOTE 12,'UNABLE TO DETERMINE LENGTH '_
  2630.                               'FROM OPCODE (&STORE)';
  2631.                               &&Y: SETA 0;
  2632.                               END;
  2633.                            ASM IF ('&DALINIT' NE 'NO' OR _
  2634.                            '&Y' NE '&SYSLIST(&X,2)')
  2635.                            THEN SYSLST &&DALLEN+&&DALPL,NEW=&&Y,_
  2636.                                        STORE=STOREH;
  2637.                            ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2638.                               SYSLST &&DALLEN+2+&&DALPL,_
  2639.                                      NEW=&&SYSLIST(&&X,1),STORE=&&STORE;
  2640.                               END;
  2641.                            END;
  2642.                         END;
  2643.                      END;
  2644.                   ASM IF ('&SYSLIST(&X,2)' NE '') THEN BEGIN
  2645.                      DAL&&Y&&@: EQU &&DALLEN+2+&&SYSLIST(&&X,2);
  2646.                      END
  2647.                   ELSE BEGIN
  2648.                      ASM IF ('&MF' NE 'L') THEN BEGIN
  2649.                         DAL&&Y&&@: EQU &&DALLEN+2+&&LQ&&SYSLIST(&&X,1);
  2650.                         END
  2651.                      ELSE BEGIN
  2652.                         DAC&&Y&&@: DS 0&&SYSLIST(&&X,1);
  2653.                         DAL&&Y&&@: EQU &&DALLEN+2+L'DAC&&Y&&@;
  2654.                         END;
  2655.                      END;
  2656.                   &&DALLEN: SETC 'DAL&Y&@';
  2657.                   END;
  2658.                END;
  2659.             'R': BEGIN
  2660.                &&L: SYSLBL;
  2661.                DALT&&@: EQU &&DALLEN+4;
  2662.                &&DALLEN: SETC 'DALT&@';
  2663.                ASM FOR &&X FROM 3 TO N'&&SYSLIST DO BEGIN
  2664.                   &&Y: SETA &&X-2;
  2665.                   ASM IF ('&MF' NE 'L') THEN BEGIN
  2666.                      ASM IF ('&SYSLIST(&X,3)' EQ '') THEN BEGIN
  2667.                         ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2668.                            DALLISTM &&SYSLIST(&&X,1),_
  2669.                            &&DALLEN+2+&&DALPL,&&SYSLIST(&&X,2);
  2670.                            END;
  2671.                         END
  2672.                      ELSE BEGIN
  2673.                         ASM IF ('&SYSLIST(&X,3)'(1,1) NE '''')
  2674.                         THEN BEGIN
  2675.                            ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2676.                               DALLISTM &&SYSLIST(&&X,1),_
  2677.                               &&DALLEN+2+&&DALPL,&&SYSLIST(&&X,3);
  2678.                               END;
  2679.                            END
  2680.                         ELSE BEGIN
  2681.                            &&STORE: SETC '&SYSLIST(&X,3)'(2,_
  2682.                                       K'&&SYSLIST(&&X,3)-1);
  2683.                            ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2684.                               ASM CASE '&STORE';
  2685.                                  'STC','STOREB': <&&LOAD: SETC 'IC'>;
  2686.                                  'STOREH','STOREH','STORELH':
  2687.                                  <&&LOAD: SETC 'LOADH'>;
  2688.                                  'STOREP': <&&LOAD: SETC 'LOADP'>;
  2689.                                  'ST','STOREF','STORELF':
  2690.                                  <&&LOAD: SETC 'LOADF'>;
  2691.                                  ENDCASE
  2692.                               ELSE BEGIN
  2693.                                  MNOTE 12,'UNABLE TO DETERMINE PROPER '_
  2694.                                  'LOAD OPERATION FOR STORE OPERATION '_
  2695.                                  '&STORE';
  2696.                                  &&LOAD: SETC '?';
  2697.                                  END;
  2698.                               SYSLST &&DALLEN+2+&&DALPL,OLD=RTNR,_
  2699.                               LOAD=&&LOAD;
  2700.                               SYSLST &&SYSLIST(&&X,1),NEW=(RTNR),_
  2701.                               STORE=&&STORE;
  2702.                               END;
  2703.                            END;
  2704.                         END;
  2705.                      END;
  2706.                   ASM IF ('&SYSLIST(&X,2)' NE '') THEN BEGIN
  2707.                      DAL&&Y&&@: EQU &&DALLEN+2+&&SYSLIST(&&X,2);
  2708.                      END
  2709.                   ELSE BEGIN
  2710.                      ASM IF ('&MF' NE 'L') THEN BEGIN
  2711.                         DAL&&Y&&@: EQU &&DALLEN+2+&&LQ&&SYSLIST(&&X,1);
  2712.                         END
  2713.                      ELSE BEGIN
  2714.                         DAC&&Y&&@: DS 0&&SYSLIST(&&X,1);
  2715.                         DAL&&Y&&@: EQU &&DALLEN+2+L'DAC&&Y&&@;
  2716.                         END;
  2717.                      END;
  2718.                   &&DALLEN: SETC 'DAL&Y&@';
  2719.                   END;
  2720.                END;
  2721.             ENDCASE ELSE;
  2722.          END;
  2723.       'END': BEGIN
  2724.          ASM IF (NOT &&DALSW) THEN BEGIN
  2725.             MNOTE 12,'NO CORRESPONDING DALLIST BEGIN';
  2726.             &&L: SYSLBL;
  2727.             MEXIT;
  2728.             END;
  2729.          ASM IF ('&DALMF' EQ '' OR '&DALMF' EQ 'L') THEN BEGIN
  2730.             &&L: SYSLBL TYPE=F;
  2731.             &&DALPTR: DS 0F;
  2732.             ASM IF (&&DALNUM LE 0)
  2733.             THEN MNOTE 12,'NO DALLIST TEXT ITEMS'
  2734.             ELSE BEGIN
  2735.                ASM FOR &&X FROM 1 TO &&DALNUM-1 DO BEGIN
  2736.                   DC A(&&DALLBL(&&X));
  2737.                   END
  2738.                THEN BEGIN
  2739.                   DC A(X'80000000'+&&DALLBL(&&DALNUM));
  2740.                   END;
  2741.                END;
  2742.             END;
  2743.          ASM IF ('&DALMF' EQ 'E' OR '&DALMF' EQ 'R') THEN BEGIN
  2744.             &&L: SYSLBL;
  2745.             END;
  2746.          ASM IF ('&DALMF' EQ 'E' AND '&DALINIT' NE 'NO') THEN BEGIN
  2747.             &&DALPTR: EQU (&&DALLEN+3)/4*4+&&DALPL;
  2748.             &&Y: SETA 0;
  2749.             ASM FOR &&X FROM 1 TO &&DALNUM DO BEGIN
  2750.                &&Y: SETA (&&X-1)*4;
  2751.                SYSLST &&DALPTR+&&Y,NEW=&&DALLBL(&&X)-4+&&DALPL;
  2752.                END;
  2753.             OI &&DALPTR+&&Y,X'80';
  2754.             END;
  2755.          ASM IF ('&DALMF' EQ '' OR '&DALMF' EQ 'E') THEN BEGIN
  2756.             ASM IF ('&DALMF' EQ '') THEN <&&DALEND: SYSLBL>;
  2757.             ASM IF ('&SVC' NE 'NO') THEN BEGIN
  2758.                SYSLR VR1,&&DALPL;
  2759.                DYNALLOC;
  2760.                END;
  2761.             END;
  2762.          &&DALSW: SETB 0;
  2763.          END;
  2764.       ENDCASE
  2765.    ELSE BEGIN
  2766.       MNOTE 12,'"DALLIST &TYPE" IS ILLEGAL';
  2767.       &&L: SYSLBL;
  2768.       END;
  2769.    MEND;
  2770. BAL;
  2771. ./       ADD   LIST=ALL,NAME=DALLISTM
  2772. ALP;
  2773.  
  2774. MACRO &&L: DALLISTM &&TO,&&FROM,&&LEN;
  2775.    ASM IF ('&LEN' EQ '') THEN MMVC &&TO,&&FROM
  2776.    ELSE BEGIN
  2777.       ASM IF ('&LEN'(1,1) NE '(')
  2778.       THEN MMVC &&TO,&&FROM,&&LEN
  2779.       ELSE IF <RP &&LEN> THEN EXI &&LEN,MMVC,&&TO,&&FROM,DECR=YES,_
  2780.                                   INCR=YES;
  2781.       END;
  2782.    MEND;
  2783.  
  2784. BAL;
  2785. ./       ADD   LIST=ALL,NAME=DALMSG
  2786. ALP;
  2787.  
  2788.  MACRO &&LBL: DALMSG &&DALLIST=,&&RC=,&&MSG1=,_
  2789.  &&FLAGS1=,&&FLAGS2=,_
  2790.  &&MSG2=,&&MSG2LEN=,&&MSG1LEN=,&&MF=L;
  2791.     LCLC  &&Q,&&OP,&&F1,&&F2;
  2792. &&Q:     SETC  '&SYSNDX';
  2793. &&F1: SETC '40';  % DEFAULT FLAGS
  2794. &&F2: SETC '33';  % DEFAULT FLAGS2
  2795.     &&OP:    SETC  'DC';  % ASSUME LIST FORM
  2796.  ASMIF ('&MF(1)' EQ 'L') THEN
  2797.     BEGIN
  2798.        ASMIF ('&FLAGS1' NE '') THEN &&F1: SETC '&FLAGS1';
  2799.        ASMIF ('&FLAGS2' NE '') THEN &&F2: SETC '&FLAGS2';
  2800.     DAMS&&Q:   DS    0F;
  2801.     &&LBL:     &&OP    A(0);
  2802.     &&OP    A(DAMR&&Q); %RETURN CODE
  2803.     &&OP    A(*+8); %ZEROES
  2804.     &&OP    A(DAMF&&Q); %FLAGS
  2805.     &&OP    A(0);
  2806.     &&OP    A(DAMB&&Q); %BUFFER
  2807.     DAMR&&Q:   &&OP   A(0); %WILL CONTAIN RETURN CODE
  2808.     DAMF&&Q:   &&OP   X'&F1',X'&F2'; %FLAGS
  2809.     DAMB&&Q:   DS   0H;
  2810.     &&MSG1LEN: &&OP   H'0',H'0'; %LENGTH OF 1ST MSG, 0
  2811.     &&MSG1:    &&OP    CL251' '; %TEXT OF 1ST MESSAGE
  2812.     &&MSG2LEN: &&OP   H'0',H'0'; %LENGTH OF 2ND MSG, 0
  2813.     &&MSG2:    &&OP    CL251' ';
  2814.        MEXIT;
  2815.        END;
  2816.     &&LBL:   SYSLR VR0,&&RC,OP=L;
  2817.     SYSLR VR1,&&MF(2);
  2818.     ST    VR0,24(,VR1);
  2819.     ASMIF ('&FLAGS1' NE '') THEN
  2820.     BEGIN
  2821.        MVI   28(VR1),X'&F1';
  2822.        END;
  2823.     ASMIF ('&FLAGS2' NE '') THEN
  2824.     BEGIN
  2825.        MVI   29(VR1),X'&F2';
  2826.        END;
  2827.     SYSLR VR1,&&DALLIST,OP=L;
  2828.     ST    VR1,&&MF(2);
  2829.     LA    VR1,&&MF(2);
  2830.     LINK  EP=IKJEFF18;
  2831.     MEND;
  2832. BAL;
  2833. ./       ADD   LIST=ALL,NAME=DBCCALL
  2834. ALP;
  2835.  
  2836. MACRO &&L: DBCCALL &&STR,&&IF=;
  2837.    GBLC &&DBC;
  2838.    LCLC &&LBL,&&CODE,&&MSG(8);
  2839.    LCLA &&LEN,&&P,&&Q,&&X;
  2840.  
  2841.    ASM IF ('&IF' EQ '') THEN BEGIN  % UNCONDITIONAL CALL
  2842.       ASM IF ('&DBC' NE 'YES') THEN BEGIN
  2843.          ASM IF ('&STR' EQ '')
  2844.          THEN <&&L: DC H'0'>
  2845.          ELSE <&&L: DC 0H'0',X'00',C&&STR>;
  2846.          END
  2847.       ELSE BEGIN
  2848.          ASM IF ('&STR' EQ '') THEN <&&L: DC 0H'0',X'00DEAD00'>
  2849.          ELSE BEGIN
  2850.             &&LBL: SETC 'DBC&@.A';
  2851.             ASM IF ('&L' NE '') THEN <&&LBL: SETC '&L'>;
  2852.             &&LBL: DC 0H'0',X'00DEAD',AL1(DBC&&@.L),C&&STR;
  2853.             DBC&&@.L: EQU *-&&LBL-4;
  2854.             END;
  2855.          END;
  2856.       END
  2857.    ELSE BEGIN  % CONDITIONAL CALL
  2858.       &&P: SETA 1;
  2859.       ASM FOR &&X FROM 2 TO K'&&STR-2 DO BEGIN
  2860.          &&LEN: SETA &&LEN+1;
  2861.          ASM IF (K'&&MSG(&&P) GE 8) THEN <&&P: SETA &&P+1>;
  2862.          &&MSG(&&P): SETC '&MSG(&P)'.'&STR'(&&X,1);
  2863.          ASM IF ('&STR'(&X,1) EQ ''''''(1,1)) THEN BEGIN
  2864.             &&Q: SETA (&&Q+1)-(&&Q+1)/2*2;
  2865.             &&LEN: SETA &&LEN-&&Q;
  2866.             END;
  2867.          END;
  2868.       &&CODE: SETC '';  % X'00'
  2869.       ASM IF ('&DBC' EQ 'YES') THEN BEGIN
  2870.          &&CODE: SETC '#[';  % X'00DEAD'
  2871.          ASM SELECT FIRST;
  2872.             (&&LEN LT 64): &&CODE: SETC '&CODE'._
  2873. '    
  2874. 
  2875. '_
  2876.             ''(&&LEN,1);
  2877.             (&&LEN LT 2*64): &&CODE: SETC '&CODE'._
  2878. ' &akb+ .<(+|&&)*[%c(!$*);^-/_\]^,:,%_>?W012|V{`:#@''="'_
  2879.             ''(&&LEN-64,1);
  2880.             (&&LEN LT 3*64): &&CODE: SETC '&CODE'._
  2881. 'xabcdefghi$s/.E jklmnopqrNq~H~stuvwxyzo@Z[ry56}789f;<=
  2882. Y?]XD'_
  2883.             ''(&&LEN-2*64,1);
  2884.             (&&LEN LT 4*64): &&CODE: SETC '&CODE'._
  2885. '{ABCDEFGHIKJ>hlm}JKLMNOPQR!-ut#\gSTUVWXYZ idQ01234567893wpz''_
  2886.             ''(&&LEN-3*64,1);
  2887.             ENDSEL;
  2888.          END;
  2889.       ASM IF ((&&LEN+K'&&CODE) NE (&&LEN+K'&&CODE)/2*2) THEN BEGIN
  2890.          &&LEN: SETA &&LEN+1;
  2891.          ASM IF (K'&&MSG(&&P) GE 8) THEN <&&P: SETA &&P+1>;
  2892.          &&MSG(&&P): SETC '&MSG(&P)'.' ';
  2893.          END;
  2894.       SYSPRED =C'&CODE&MSG(1)&MSG(2)&MSG(3)&MSG(4)&MSG(5)&MSG(6)'_
  2895.       '&MSG(7)&MSG(8)',IF=&&IF;
  2896.       END;
  2897.    MEND;
  2898. BAL;
  2899. ./       ADD   LIST=ALL,NAME=DCC
  2900.          MACRO
  2901. &L       DCC   &CONST,&LENGTH=
  2902.          AIF   ('&LENGTH' EQ '').NULL
  2903.          AIF   ('&LENGTH' EQ '0').ZERO
  2904. &L       DC    &CONST
  2905.          MEXIT
  2906. .*
  2907. .NULL    ANOP
  2908.          MNOTE 12,'LENGTH MUST BE SPECIFIED'
  2909. .*
  2910. .ZERO    ANOP
  2911.          AIF   ('&L' EQ '').END
  2912. &L       EQU   *,0
  2913. .END     MEND
  2914. ./       ADD   LIST=ALL,NAME=DEBLANK
  2915.          MACRO
  2916. &L       DEBLANK &S,&N,&W,&TYPE=RIGHT,&ZERO=YES,&NULL=YES,&LABEL=,     *
  2917.                &FILL=C' ',&FILADDR=
  2918.          LCLB  &END
  2919.          LCLC  &LL,&R
  2920.          LCLA  &D
  2921.          SYSKWT TYPE,&TYPE,(LEFT,RIGHT,BOTH,NONE),COND=NO,NULL=NO
  2922.          SYSKWT ZERO,&ZERO,(YES,NO),COND=NO,NULL=NO
  2923.          SYSKWT NULL,&NULL,(YES,NO),COND=NO,NULL=NO
  2924.          AIF   ('&TYPE' EQ '').NONE
  2925. &LL      SETC  '&L'
  2926. &R       SETC  'DEBL&SYSNDX'
  2927.          AIF   ('&LABEL' EQ '' OR '&NULL' EQ 'NO').NR
  2928. &R       SETC  '&LABEL'
  2929. .NR      ANOP
  2930.          AIF   ('&TYPE' EQ 'LEFT').LEFT
  2931.          AIF   ('&W' NE '' AND '&W' NE '&S').DIFF
  2932.          AIF   ('&ZERO' EQ 'NO').NZ1
  2933. &LL      LTR   &N,&N                   TEST LENGTH
  2934.          BNP   &R                      BR IF ZERO
  2935. &END     SETB  1
  2936. &LL      SETC  ''
  2937. .NZ1     ANOP
  2938. &LL      ALR   &S,&N                   POINT AT END OF STRING
  2939. &LL      SETC  ''
  2940.          BCTR  &S,0                    NEXT CHARACTER
  2941.          DEBLANKT &S,&FILL,&FILADDR    IS IT BLANK?
  2942.    AIF ('&NULL' EQ 'NO' OR ('&LABEL' EQ '' AND '&TYPE' EQ 'RIGHT')).NN1
  2943.          BNE   *+12                    BR IF NOT BLANK
  2944.          BCT   &N,*-10                 DECR. COUNT AND TRY AGAIN
  2945.          B     &R                      BR IF NULL RESULT
  2946. &END     SETB  1
  2947.          SLR   &S,&N                   COMPUTE START OF STRING
  2948.          LA    &S,1(,&S)
  2949.          AGO   .LEFT
  2950. .NN1     BNE   *+8                     BR IF NOT BLANK
  2951.          BCT   &N,*-10                 DECR. COUNT AND TRY AGAIN
  2952.          SLR   &S,&N                   COMPUTE START OF STRING
  2953.          LA    &S,1(,&S)
  2954.          AGO   .LEFT
  2955. .DIFF    ANOP
  2956. &LL      LTR   &W,&N                   COUNT TO WORK REGISTER
  2957. &LL      SETC  ''
  2958.          AIF   ('&ZERO' EQ 'NO').NZ2
  2959.          BNP   &R                      BR IF NULL STRING
  2960. &END     SETB  1
  2961. .NZ2     ALR   &W,&S                   POINT AT END OF STRING
  2962.          BCTR  &W,0                    NEXT CHARACTER
  2963.          DEBLANKT &W,&FILL,&FILADDR    IS IT BLANK?
  2964.    AIF ('&NULL' EQ 'NO' OR ('&LABEL' EQ '' AND '&TYPE' EQ 'RIGHT')).NN2
  2965.          BNE   *+12                    BR IF NOT BLANK
  2966.          BCT   &N,*-10                 DECR. COUNT AND TRY AGAIN
  2967.          B     &R                      BR IF NULL RESULT
  2968. &END     SETB  1
  2969.          AGO   .LEFT
  2970. .NN2     BNE   *+8                     BR IF NOT BLANK
  2971.          BCT   &N,*-10                 DECR. COUNT AND TRY AGAIN
  2972. .LEFT    AIF   ('&TYPE' EQ 'RIGHT').DONE
  2973.          AIF   ('&ZERO' EQ 'NO' OR '&TYPE' NE 'LEFT').NZ3
  2974. &LL      LTR   &N,&N                   TEST FOR ZERO LENGTH
  2975.          BNP   &R                      BR IF ZERO
  2976. &END     SETB  1
  2977. &LL      SETC  ''
  2978. .NZ3     ANOP
  2979. &LL      DEBLANKT &S,&FILL,&FILADDR    CHARACTER BLANK?
  2980. &LL      SETC  ''
  2981. &D       SETA  12
  2982.          AIF   ('&R' EQ 'DEBL&SYSNDX').N16
  2983. &D       SETA  16
  2984. .N16     ANOP
  2985.          AIF   ('&TYPE' NE 'LEFT' AND ('&W' EQ '' OR '&W' EQ '&S')).NLA
  2986.          BNE   *+&D                    BR IF NOT BLANK
  2987.          LA    &S,1(,&S)               NEXT CHARACTER
  2988.          AGO   .BCT
  2989. .NLA     ANOP
  2990. &D       SETA  &D-4
  2991.          BNE   *+&D
  2992. .BCT     BCT   &N,*-12                 DECR. COUNT AND TRY AGAIN
  2993.          AIF   ('&R' EQ 'DEBL&SYSNDX').DONE
  2994.          B     &R                      NULL RESULT
  2995. .DONE    AIF   (&END EQ 0 OR '&R' NE 'DEBL&SYSNDX').NL
  2996. DEBL&SYSNDX DS 0H
  2997. .NL      MEXIT
  2998. .NONE    ANOP
  2999. &L       SYSLBL
  3000.          MEND
  3001. ./       ADD   LIST=ALL,NAME=DEBLANKT
  3002.          MACRO
  3003. &L       DEBLANKT &R,&FILL,&FILADDR
  3004.          AIF   ('&FILADDR' EQ '').FILL
  3005. &L       CLC   0(1,&R),&FILADDR
  3006.          MEXIT
  3007. .*
  3008. .FILL    ANOP
  3009. &L       CLI   0(&R),&FILL
  3010.          MEND
  3011. ./       ADD   LIST=ALL,NAME=DF
  3012.          MACRO
  3013. &L       DF    &INIT=
  3014.          LCLA  &X,&Y,&Z,&V
  3015.          LCLC  &T(8),&S,&I(10)
  3016. .*
  3017. &T(1)    SETC  '80'
  3018. &T(2)    SETC  '40'
  3019. &T(3)    SETC  '20'
  3020. &T(4)    SETC  '10'
  3021. &T(5)    SETC  '08'
  3022. &T(6)    SETC  '04'
  3023. &T(7)    SETC  '02'
  3024. &T(8)    SETC  '01'
  3025. .*
  3026. &Y       SETA  1
  3027. &I(1)    SETC  '0'
  3028. .*
  3029.          AIF   ('&L' EQ '').NLBL
  3030. &V       SETA  (N'&SYSLIST+7)/8
  3031. &L       DS    0XL&V
  3032. .NLBL    ANOP
  3033. .*
  3034. .LOOP    ANOP
  3035.          AIF   ((&X EQ 0 OR &X/8*8 NE &X) AND &X LT N'&SYSLIST).NDS
  3036. .*
  3037. .CLEAR   ANOP
  3038. &Y       SETA  &Y+1
  3039. &I(&Y)   SETC  ''
  3040.          AIF   (&Y LT 9).CLEAR
  3041. &Y       SETA  1
  3042. .*
  3043.          DC    AL1(&I(1)&I(2)&I(3)&I(4)&I(5)&I(6)&I(7)&I(8)&I(9))
  3044. .NDS     ANOP
  3045. .*
  3046. &X       SETA  &X+1
  3047.          AIF   (&X GT N'&SYSLIST).END
  3048. &S       SETC  '&T(&X-(&X-1)/8*8)'
  3049. &SYSLIST(&X) DS 0XL(X'&S')
  3050. .*
  3051. &Z       SETA  0
  3052. .INIT    ANOP
  3053. &Z       SETA  &Z+1
  3054.          AIF   (&Z GT N'&INIT).LOOP
  3055.          AIF   ('&SYSLIST(&X)' NE '&INIT(&Z)').INIT
  3056. &Y       SETA  &Y+1
  3057. &I(&Y)   SETC  '+X''&S'''
  3058.          AGO   .LOOP
  3059. .*
  3060. .END     MEND
  3061. ./       ADD   LIST=ALL,NAME=DI
  3062.          MACRO
  3063. &L       DI    &R,&V
  3064.          LCLA  &X
  3065. .*
  3066. .LOOP    ANOP
  3067. &X       SETA  &X+1
  3068.          AIF   (&X GT K'&V).INT
  3069.          AIF   ('&V'(&X,1) GE '0' AND '&V'(&X,1) LE '9').LOOP
  3070. .*
  3071. &L       D     &R,=A(&V)
  3072.          MEXIT
  3073. .*
  3074. .INT     ANOP
  3075. &L       D     &R,=F'&V'
  3076.          MEND
  3077. ./       ADD   LIST=ALL,NAME=DSC
  3078.          MACRO
  3079. &L       DSC   &CONST,&LENGTH=
  3080.          AIF   ('&LENGTH' EQ '').NULL
  3081.          AIF   ('&LENGTH' EQ '0').ZERO
  3082. &L       DS    &CONST
  3083.          MEXIT
  3084. .*
  3085. .NULL    ANOP
  3086.          MNOTE 12,'LENGTH MUST BE SPECIFIED'
  3087. .*
  3088. .ZERO    ANOP
  3089.          AIF   ('&L' EQ '').END
  3090. &L       EQU   *,0
  3091. .END     MEND
  3092. ./       ADD   LIST=ALL,NAME=EDIT
  3093.          MACRO
  3094. &L       EDIT  &T,&F,&TL,&FL,&CALC=YES,&DIGITS=1,&MARK=NO
  3095.          LCLA  &TOLEN,&FLEN,&D,&IX
  3096.          LCLC  &H(16),&MK
  3097. .*
  3098.          AIF   ('&TL' NE '').USETL
  3099.          AIF   (T'&T NE 'N' AND T'&T NE 'O' AND T'&T NE 'T' AND        X
  3100.                T'&T NE 'W' AND T'&T NE 'U' AND T'&T NE '$' AND         X
  3101.                T'&T NE 'M').TOOK
  3102.        MNOTE 12,'TO FIELD DOES NOT HAVE AN EXPLICIT OR IMPLICIT LENGTH'
  3103.          MEXIT
  3104. .TOOK    ANOP
  3105. &TOLEN   SETA  L'&T
  3106.          MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&TOLEN)'
  3107.          AGO   .CKFL
  3108. .USETL   ANOP
  3109. &TOLEN   SETA  &TL
  3110. .CKFL    ANOP
  3111.          AIF   ('&FL' NE '').USEFL
  3112.          AIF   (T'&F NE 'N' AND T'&F NE 'O' AND T'&F NE 'T' AND        X
  3113.                T'&F NE 'W' AND T'&F NE 'U' AND T'&F NE '$' AND         X
  3114.                T'&F NE 'M').FOK
  3115.      MNOTE 12,'FROM FIELD DOES NOT HAVE AN EXPLICIT OR IMPLICIT LENGTH'
  3116.          MEXIT
  3117. .FOK     ANOP
  3118. &FLEN    SETA  L'&F
  3119.          AGO   .LENDONE
  3120. .USEFL   ANOP
  3121. &FLEN    SETA  &FL
  3122.          MNOTE *,'LENGTH ATTRIBUTE OF SECOND OPERAND USED (&FLEN)'
  3123. .LENDONE ANOP
  3124. .*
  3125.          AIF   (2*(&TOLEN/2) EQ &TOLEN).LENOK
  3126.          MNOTE 4,'LENGTH OF &T MUST BE EVEN'
  3127.          MEXIT
  3128. .LENOK   ANOP
  3129.          AIF   (&FLEN+&FLEN GE &TOLEN).NEXT
  3130.          MNOTE 4,'&F DOES NOT HAVE ENOUGH SOURCE DIGITS'
  3131.          MEXIT
  3132. .NEXT    ANOP
  3133.          AIF   ('&MARK' EQ 'NO').NOMK
  3134. &MK      SETC  'MK'
  3135. .NOMK    ANOP
  3136. .*
  3137. &IX      SETA  1
  3138. &H(1)    SETC  '40'
  3139. .L1      ANOP
  3140. &IX      SETA  &IX+1
  3141. &H(&IX)  SETC  '20'
  3142.          AIF   (&IX LT &TOLEN).L1
  3143. .*
  3144. &D       SETA  &DIGITS
  3145.          AIF   (&D EQ 0 OR &TOLEN EQ 2).NOSIG
  3146. &H(&IX-&D) SETC '21'
  3147. .NOSIG   ANOP
  3148. .*
  3149. &L       SYSXXCB MVC,&T,=X'&H(1)&H(2)&H(3)&H(4)&H(5)&H(6)&H(7)&H(8)&H(9X
  3150.                )&H(10)&H(11)&H(12)&H(13)&H(14)&H(15)&H(16)',&TOLEN
  3151.          AIF   ('&MARK' EQ 'NO').NOMK2
  3152.          LA    1,&T+&TOLEN-&D
  3153. .NOMK2   ANOP
  3154. .*
  3155.          AIF   ('&CALC' EQ 'YES').CALC
  3156.          SYSXXCB ED&MK,&T,&F,&TOLEN
  3157.          MEXIT
  3158. .CALC    ANOP
  3159.          SYSXXCB ED&MK,&T,&FLEN-(&TOLEN-1)/2-1+&F,&TOLEN
  3160.          MEND
  3161. ./       ADD   LIST=ALL,NAME=EXI
  3162.          MACRO
  3163. &L       EXI   &R,&OP,&A,&B,&DECR=NO,&INCR=NO
  3164.          GBLC  &EXOP(25),&EXA(250),&EXB(250)
  3165.          GBLA  &EXORG,&EXN
  3166.          LCLA  &X,&Z
  3167.          LCLC  &LBL
  3168. .*
  3169.          SYSKWT DECR,&DECR,(YES,NO),COND=NO,NULL=NO
  3170.          SYSKWT INCR,&INCR,(YES,NO),COND=NO,NULL=NO
  3171. .*
  3172. &LBL     SETC  '&L'
  3173. .*
  3174.          AIF   ('&DECR' NE 'YES').NDECR
  3175. &LBL     SI    &R,1
  3176. &LBL     SETC  ''
  3177. .NDECR   ANOP
  3178. .*
  3179. &X       SETA  0
  3180. .SLOOP   ANOP
  3181. &X       SETA  &X+1
  3182.          AIF   (&X GT &EXN).SDONE
  3183.          AIF   ('&OP' NE '&EXOP(&X)').SLOOP
  3184. &Z       SETA  (&X-1)*10
  3185.          AIF   ('&A' NE '&EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&*
  3186.                Z+5)&EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10)'*
  3187.                ).SLOOP
  3188.          AIF   ('&B' NE '&EXB(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&*
  3189.                Z+5)&EXB(&Z+6)&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10)'*
  3190.                ).SLOOP
  3191. .*
  3192. &X       SETA  &EXORG+&X
  3193. &LBL     EX    &R,EXI#&X
  3194.          AGO   .INCR
  3195. .*
  3196. .SDONE   ANOP
  3197. .*
  3198.          AIF   (&EXN LT 25).OK
  3199.          MNOTE 12,'EXI TABLE FULL'
  3200. &LBL     EX    &R,0
  3201.          AGO   .INCR
  3202. .*
  3203. .OK      ANOP
  3204. .*
  3205. &EXN     SETA  &EXN+1
  3206. .*
  3207. &X       SETA  &EXORG+&EXN
  3208. &LBL     EX    &R,EXI#&X
  3209. .*
  3210. &EXOP(&EXN) SETC '&OP'
  3211. .*
  3212. &X       SETA  0
  3213.          AIF   ('&A' EQ '').AFILL
  3214. .ALOOP   ANOP
  3215. &X       SETA  &X+1
  3216.          AIF   (&X*8 GE K'&A).ADONE
  3217. &EXA((&EXN-1)*10+&X) SETC '&A'((&X-1)*8+1,8)
  3218.          AIF   (&X LT 10).ALOOP
  3219.          MNOTE 12,'OPERAND TOO LONG'
  3220.          AGO   .AFILLED
  3221. .*
  3222. .ADONE   ANOP
  3223. &EXA((&EXN-1)*10+&X) SETC '&A'((&X-1)*8+1,K'&A-(&X-1)*8)
  3224. .AFILL   ANOP
  3225. &X       SETA  &X+1
  3226.          AIF   (&X GT 10).AFILLED
  3227. &EXA((&EXN-1)*10+&X) SETC ''
  3228.          AGO   .AFILL
  3229. .*
  3230. .AFILLED ANOP
  3231. .*
  3232. &X       SETA  0
  3233.          AIF   ('&B' EQ '').BFILL
  3234. .BLOOP   ANOP
  3235. &X       SETA  &X+1
  3236.          AIF   (&X*8 GE K'&B).BDONE
  3237. &EXB((&EXN-1)*10+&X) SETC '&B'((&X-1)*8+1,8)
  3238.          AIF   (&X LT 10).BLOOP
  3239.          MNOTE 12,'OPERAND TOO LONG'
  3240.          AGO   .BFILLED
  3241. .*
  3242. .BDONE   ANOP
  3243. &EXB((&EXN-1)*10+&X) SETC '&B'((&X-1)*8+1,K'&B-(&X-1)*8)
  3244. .BFILL   ANOP
  3245. &X       SETA  &X+1
  3246.          AIF   (&X GT 10).BFILLED
  3247. &EXB((&EXN-1)*10+&X) SETC ''
  3248.          AGO   .BFILL
  3249. .*
  3250. .BFILLED ANOP
  3251. .*
  3252. .INCR    ANOP
  3253.          AIF   ('&INCR' NE 'YES').NINCR
  3254.          AI    &R,1
  3255. .NINCR   ANOP
  3256. .*
  3257.          MEND
  3258. ./       ADD   LIST=ALL,NAME=EXORG
  3259.          MACRO
  3260. &L       EXORG
  3261.          GBLC  &EXOP(25),&EXA(250),&EXB(250)
  3262.          GBLA  &EXORG,&EXN
  3263.          LCLA  &X,&Y,&Z
  3264. .*
  3265. &L       SYSLBL
  3266. .*
  3267. &Y       SETA  &EXN
  3268. &EXN     SETA  0
  3269. .*
  3270. .LOOP    ANOP
  3271. &X       SETA  &X+1
  3272.          AIF   (&X GT &Y).END
  3273. &Z       SETA  (&X-1)*10
  3274. &EXORG   SETA  &EXORG+1
  3275.          AIF   ('&EXOP(&X)' EQ 'MCLC').MCLC
  3276.          AIF   ('&EXOP(&X)' EQ 'MMVC').MMVC
  3277.          AIF   ('&EXOP(&X)' EQ 'MNC').MNC
  3278.          AIF   ('&EXOP(&X)' EQ 'MOC').MOC
  3279.          AIF   ('&EXOP(&X)' EQ 'MXC').MXC
  3280.          AIF   ('&EXOP(&X)' EQ 'MTC').MTC
  3281.          AIF   ('&EXOP(&X)' EQ 'MTR').MTR
  3282.          AIF   ('&EXOP(&X)' EQ 'MTRT').MTRT
  3283.          AIF   ('&EXOP(&X)' EQ 'MZC').MZC
  3284. EXI#&EXORG EXORGA &EXOP(&X),&EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EX*
  3285.                A(&Z+5)&EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+1*
  3286.                0),&EXB(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EX*
  3287.                B(&Z+6)&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10)
  3288.          AGO   .LOOP
  3289. .*
  3290. .MCLC    ANOP
  3291. EXI#&EXORG MCLC      &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3292.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3293.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3294.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3295.          AGO   .LOOP
  3296. .*
  3297. .MMVC    ANOP
  3298. EXI#&EXORG MMVC      &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3299.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3300.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3301.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3302.          AGO   .LOOP
  3303. .*
  3304. .MNC     ANOP
  3305. EXI#&EXORG MNC       &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3306.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3307.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3308.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3309.          AGO   .LOOP
  3310. .*
  3311. .MOC     ANOP
  3312. EXI#&EXORG MOC       &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3313.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3314.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3315.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3316.          AGO   .LOOP
  3317. .*
  3318. .MTC     ANOP
  3319. EXI#&EXORG MTC   &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)&EXA*
  3320.                (&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),0,N=1
  3321.          AIF   ('&EXB(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB*
  3322.                (&Z+6)&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10)' EQ '').*
  3323.                MTCOK
  3324.          MNOTE 12,'TWO OPERANDS ILLEGAL FOR EXI MTC'
  3325. .MTCOK   ANOP
  3326.          AGO   .LOOP
  3327. .*
  3328. .MTR     ANOP
  3329. EXI#&EXORG MTR       &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3330.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3331.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3332.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3333.          AGO   .LOOP
  3334. .*
  3335. .MTRT    ANOP
  3336. EXI#&EXORG MTRT      &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3337.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3338.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3339.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3340.          AGO   .LOOP
  3341. .*
  3342. .MXC     ANOP
  3343. EXI#&EXORG MXC       &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3344.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3345.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3346.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3347.          AGO   .LOOP
  3348. .*
  3349. .MZC     ANOP
  3350. EXI#&EXORG MZC   &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)&EXA*
  3351.                (&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),0,N=1
  3352.          AIF   ('&EXB(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB*
  3353.                (&Z+6)&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10)' EQ '').*
  3354.                MZCOK
  3355.          MNOTE 12,'TWO OPERANDS ILLEGAL FOR EXI MZC'
  3356. .MZCOK   ANOP
  3357.          AGO   .LOOP
  3358. .*
  3359. .END     MEND
  3360. ./       ADD   LIST=ALL,NAME=EXORGA
  3361.          MACRO
  3362. &L       EXORGA &OP,&A,&B
  3363.          AIF   ('&B' EQ '').ONE
  3364. &L       &OP   &A,&B
  3365.          MEXIT
  3366. .*
  3367. .ONE     ANOP
  3368. &L       &OP   &A
  3369.          MEND
  3370. ./       ADD   LIST=ALL,NAME=FASTPOST
  3371. ALP;
  3372.  
  3373. MACRO &&L: FASTPOST &&ECB,&&CODE,&®=,&&SUPMODE=,&&SAVELOC=,_
  3374. &&ENABLED=;
  3375.    GBLC &&OS;
  3376.  
  3377.    SYSKWT SUPMODE,&&SUPMODE,(YES,NO);
  3378.    SYSKWT ENABLED,&&ENABLED,(YES,NO),COND=NO;
  3379.  
  3380.    &&L: SYSLBL;
  3381.    ASM CASE '&OS';
  3382.       'MFT','MVT': ;  % NO FAST POST
  3383.       'MVS','XA': BEGIN
  3384.          ASM IF ('&SUPMODE(1)' EQ 'YES' AND '&SAVELOC' NE '') THEN BEGIN
  3385.             FPDO&&@: DO BEGIN
  3386.                ASM IF (N'&&SUPMODE GT 1) THEN BEGIN
  3387.                   SYSPRED NSUP&&@,IF=(&&SUPMODE(2),&&SUPMODE(3),_
  3388.                   &&SUPMODE(4),&&SUPMODE(5)),BRANCH=FALSE;
  3389.                   SYSLR VR1,&&ECB,ERR='ECB REQUIRED';
  3390.                   ASM IF ('&CODE' EQ '' OR '&CODE' EQ '0')
  3391.                   THEN L VR0,=XL4'40000000'
  3392.                   ELSE BEGIN
  3393.                      ASM IF ('&CODE' NE '(0)') THEN SYSLR VR0,&&CODE;
  3394.                      O VR0,=XL4'40000000';
  3395.                      END;
  3396.                   DO BEGIN
  3397.                      L VRF,0(,VR1);  % GET CURRENT VALUE OF ECB
  3398.                      IF <RNM VRF> THEN BEGIN  % NOT WAITED ON
  3399.                         CS VRF,VR0,0(VR1);  % TRY TO POST
  3400.                         EXIT FROM FPDO&&@ IF <CC E>;  % GOT IT
  3401.                         NEXT;  % TRY AGAIN
  3402.                         END;
  3403.                      END;
  3404.                   POST (1),(0);
  3405.                   EXIT;
  3406.                   NSUP&&@: ;
  3407.                   END;
  3408.                SYSLR &®,(XRA);  % SAVE REGISTER 2
  3409.                SYSCMP XRA,EQ,2;
  3410.                MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=2;  % GO KEY ZERO
  3411.                ASM IF ('&ENABLED' NE 'NO') THEN
  3412.                SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=USE,RELATED=*;
  3413.                SYSLR VR1,&&ECB,ERR='ECB REQUIRED';
  3414.                ASM IF ('&CODE' EQ '' OR '&CODE' EQ '0')
  3415.                THEN L VR0,=XL4'40000000'
  3416.                ELSE BEGIN
  3417.                   SYSLR VR0,&&CODE;
  3418.                   O VR0,=XL4'40000000';
  3419.                   END;
  3420.                ST VR0,0(,VR1);  % POST THE ECB
  3421.                IF <CLI &&SAVELOC,255> THEN BEGIN  % WAIT FLAG ON
  3422.                   MVI &&SAVELOC,0;  % TURN WAIT FLAG OFF
  3423.                   STM 3,13,12(STKR);  % SAVE REGISTERS
  3424.                   LR XRB,STKR;  % SAVE STACK POINTER
  3425.                   SYSCMP XRB,EQ,3;
  3426.                   LM 4,5,&&SAVELOC;  % GET TCB AND RB ADDRESSES
  3427.                   RESUME TCB=(4),RB=(5);  % FORCE OUT OF WAIT
  3428.                   LM 3,13,12(XRB);  % RESTORE REGISTERS
  3429.                   END;
  3430.                ASM IF ('&ENABLED' NE 'NO') THEN
  3431.                SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
  3432.                MODESET KEYADDR=(2);  % RESTORE KEY
  3433.                SYSLR XRA,(&®);  % RESTORE REGISTER 2
  3434.                END;
  3435.             ASM EXIT;
  3436.             END;
  3437.          ASM IF ('&SUPMODE(1)' EQ 'YES') THEN BEGIN
  3438.             FPDO&&@: DO BEGIN
  3439.                SYSLR VR1,&&ECB,ERR='ECB REQUIRED';
  3440.                ASM IF ('&CODE' EQ '' OR '&CODE' EQ '0')
  3441.                THEN L VR0,=XL4'40000000'
  3442.                ELSE BEGIN
  3443.                   SYSLR VR0,&&CODE;
  3444.                   O VR0,=XL4'40000000';
  3445.                   END;
  3446.                DO BEGIN
  3447.                   L VRF,0(,VR1);  % GET CURRENT VALUE OF ECB
  3448.                   IF <RNM VRF> THEN BEGIN  % NOT WAITED ON
  3449.                      CS VRF,VR0,0(VR1);  % TRY TO POST
  3450.                      EXIT FROM FPDO&&@ IF <CC E>;  % GOT IT
  3451.                      NEXT;  % TRY AGAIN
  3452.                      END;
  3453.                   END;
  3454.                ASM IF (N'&&SUPMODE GT 1) THEN BEGIN
  3455.                   SYSPRED NSUP&&@,IF=(&&SUPMODE(2),&&SUPMODE(3),_
  3456.                   &&SUPMODE(4),&&SUPMODE(5)),BRANCH=FALSE;
  3457.                   POST (1),(0);
  3458.                   EXIT;
  3459.                   NSUP&&@: ;
  3460.                   END;
  3461.                SYSLR &®,(XRA);  % SAVE REGISTER 2
  3462.                MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=2;  % KEY ZERO
  3463.                ASM IF ('&ENABLED' NE 'NO') THEN
  3464.                SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=SAVE,_
  3465.                RELATED=*;
  3466.                STM 10,11,12(STKR);  % SAVE REGISTERS
  3467.                SYSCMP STKR,EQ,13;
  3468.                LR 11,VR1;  % ECB ADDRESS
  3469.                LR 10,VR0;  % COMPLETION CODE
  3470.                L VRF,CVTPTR;  % CVT ADDRESS
  3471.                L VRF,CVT0PT01-CVT(VRF);  % ENTRY POINT TO POST
  3472.                CBALR VRE,VRF;  % CALL POST ROUTINE
  3473.                LM 10,11,12(STKR);  % RESTORE REGISTERS
  3474.                ASM IF ('&ENABLED' NE 'NO') THEN
  3475.                SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
  3476.                MODESET KEYADDR=(2);  % RESTORE KEY
  3477.                SYSLR XRA,(&®);  % RESTORE REGISTER 2
  3478.                END;
  3479.             ASM EXIT;
  3480.             END;
  3481.          END;
  3482.       ENDCASE
  3483.    ELSE MNOTE 4,'FASTPOST UNDEFINED FOR &OS, NORMAL POST USED'
  3484.    THEN BEGIN
  3485.       POST &&ECB,&&CODE;
  3486.       END;
  3487.    MEND;
  3488. BAL;
  3489. ./       ADD   LIST=ALL,NAME=FASTWAIT
  3490. ALP;
  3491.  
  3492. MACRO &&L: FASTWAIT &&COUNT,&&ECB=,&&ECBLIST=,&®=,&&SUPMODE=,_
  3493. &&LABEL=,&&SAVELOC=;
  3494.    GBLC &&OS;
  3495.  
  3496.    SYSKWT SUPMODE,&&SUPMODE,(YES,NO);
  3497.  
  3498.    ASM CASE '&OS';
  3499.       'MFT','MVT': ;  % NO FAST WAIT
  3500.       'MVS','XA': BEGIN
  3501.          ASM IF ('&SUPMODE(1)' EQ 'YES' AND '&SAVELOC' NE '') THEN BEGIN
  3502.             ASM IF ('&COUNT' NE '' AND '&COUNT' NE '1') THEN BEGIN
  3503.                MNOTE 4,'WAIT COUNT OF 1 REQUIRED WITH SAVELOC OPTION';
  3504.                END;
  3505.             &&L: SYSLBL;
  3506.             DO BEGIN
  3507.                ASM IF (N'&&SUPMODE GT 1) THEN BEGIN
  3508.                   ASM IF ('&LABEL' NE '') THEN BEGIN
  3509.                      MNOTE 12,'LABEL INVALID WITH CONDITIONAL SUPMODE';
  3510.                      END;
  3511.                   SYSPRED NSUP&&@,IF=(&&SUPMODE(2),&&SUPMODE(3),_
  3512.                   &&SUPMODE(4),&&SUPMODE(5)),BRANCH=FALSE;
  3513.                   WAIT &&COUNT,ECB=&&ECB,ECBLIST=&&ECBLIST;
  3514.                   EXIT;
  3515.                   NSUP&&@: ;
  3516.                   END;
  3517.                SYSLR &®,(XRA);  % SAVE REGISTER 2
  3518.                SYSCMP XRA,EQ,2;
  3519.                MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=2;  % GO KEY ZERO
  3520.                SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=USE,RELATED=*;
  3521.                FWDO&&@: DO BEGIN
  3522.                   ASM IF ('&ECBLIST' EQ '') THEN BEGIN
  3523.                      SYSLR VR1,&&ECB,ERR='ECB OR ECBLIST REQUIRED';
  3524.                      IF <TM 0(VR1),X'40'> THEN BEGIN  % ECB IS POSTED
  3525.                         SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
  3526.                         EXIT;
  3527.                         END;
  3528.                      END
  3529.                   ELSE BEGIN
  3530.                      SYSLR VR1,&&ECB&&ECBLIST;
  3531.                      DO BEGIN
  3532.                         L VRF,0(,VR1);  % GET ECB ADDRESS
  3533.                         IF <TM 0(VRF),X'40'> THEN BEGIN  % ECB IS POSTED
  3534.                           SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
  3535.                            EXIT FROM FWDO&&@;
  3536.                            END;
  3537.                         IF <RNM VRF> THEN BEGIN  % NOT LAST ECB
  3538.                            AI VR1,4;  % NEXT ECB
  3539.                            NEXT;
  3540.                            END;
  3541.                         END;
  3542.                      END;
  3543.                   L VRF,CVTPTR;  % GET ADDRESS OF CVT
  3544.                   L VRE,CVTTCBP-CVT(,VRF); L VRE,0(,VRE);  % GET TCB
  3545.                   L VRF,TCBRBP-TCB(,VRE);  % GET RB ADDRESS
  3546.                   ASM IF ('&OS' EQ 'MVS') THEN ZHBR VRF;
  3547.                   STM VRE,VRF,&&SAVELOC;  % SAVE TCB AND RB ADDRESS
  3548.                   MVI &&SAVELOC,255;  % INDICATE WAIT
  3549.                   ST &®,12(STKR);  % SAVE REGISTER
  3550.                   STM 11,13,12+4(STKR);  % SAVE SUSPEND REGS
  3551.                   LR &®,STKR;  % SAVE STACK REG
  3552.                   SUSPEND RB=CURRENT;  % GO INTO WAIT STATE
  3553.                   SETLOCK RELEASE,TYPE=LOCAL,RELATED=*;  % RELEASE LOCK
  3554.                   LM 11,13,12+4(&®);  % RESTORE REGISTERS
  3555.                   L &®,12(,STKR);
  3556.                   IF <CLI &&SAVELOC,255> THEN BEGIN
  3557.                      CALLDISP BRANCH=YES;  % GO TO MVS DISPATCHER
  3558.                      &&LABEL: SYSLBL;
  3559.                      END;
  3560.                   END;
  3561.                MODESET KEYADDR=(2);  % RESTORE KEY
  3562.                SYSLR XRA,(&®);  % RESTORE REGISTER 2
  3563.                END;
  3564.             ASM EXIT;
  3565.             END;
  3566.          ASM IF ('&SUPMODE(1)' EQ 'YES') THEN BEGIN
  3567.             &&L: SYSLBL;
  3568.             DO BEGIN
  3569.                ASM IF (N'&&SUPMODE GT 1) THEN BEGIN
  3570.                   ASM IF ('&LABEL' NE '') THEN BEGIN
  3571.                      MNOTE 12,'LABEL INVALID WITH CONDITIONAL SUPMODE';
  3572.                      END;
  3573.                   SYSPRED NSUP&&@,IF=(&&SUPMODE(2),&&SUPMODE(3),_
  3574.                   &&SUPMODE(4),&&SUPMODE(5)),BRANCH=FALSE;
  3575.                   WAIT &&COUNT,ECB=&&ECB,ECBLIST=&&ECBLIST;
  3576.                   EXIT;
  3577.                   NSUP&&@: ;
  3578.                   END;
  3579.                SYSLR &®,(XRA);  % SAVE REGISTER 2
  3580.                SYSCMP XRA,EQ,2;
  3581.                MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=2;  % KEY ZERO
  3582.                SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=USE,RELATED=*;
  3583.                L VRF,CVTPTR;  % GET ADDRESS OF CVT
  3584.                L VR1,CVTTCBP-CVT(,VRF); L VR1,0(,VR1);  % GET TCB ADDR
  3585.                STM VR0,VRF,TCBGRS-TCB(VR1);  % SAVE REGS IN TCB
  3586.                L VR1,TCBRBP-TCB(,VR1);  % GET RB ADDRESS
  3587.                LA VR0,WAIT&&@; ST VR0,RBOPSW+4-RB(,VR1); %RESUME ADDR
  3588.                SYSLR VR0,&&COUNT,NULL=1;  % WAIT COUNT
  3589.                ASM IF ('&ECBLIST' EQ '')
  3590.                THEN SYSLR VR1,&&ECB,ERR='ECB OR ECBLIST REQUIRED'  % ECB
  3591.                ELSE SYSLR VR1,&&ECB&&ECBLIST,TYPE=LCR;  % ECBLIST ADDR
  3592.                L VRF,CVTVWAIT-CVT(,VRF);  % ADDR OF WAIT ROUTINE
  3593.                RGOTO VRF;  % GO TO WAIT ROUTINE
  3594.                &&LABEL: SYSLBL;
  3595.                WAIT&&@:  % RESUME ADDRESS
  3596.                MODESET KEYADDR=(2);  % RESTORE KEY
  3597.                SYSLR XRA,(&®);  % RESTORE REGISTER 2
  3598.                END;
  3599.             ASM EXIT;
  3600.             END;
  3601.          END;
  3602.       ENDCASE
  3603.    ELSE MNOTE 4,'FASTWAIT UNDEFINED FOR &OS, NORMAL WAIT USED'
  3604.    THEN BEGIN
  3605.       &&L:
  3606.       WAIT &&COUNT,ECB=&&ECB,ECBLIST=&&ECBLIST;
  3607.       &&LABEL: SYSLBL;
  3608.       END;
  3609.    MEND;
  3610. BAL;
  3611. ./       ADD   LIST=ALL,NAME=FLAGSEG
  3612. ALP;
  3613.  
  3614. MACRO &&L: FLAGSEG &®=,&&VAREA=,&&ACCT=,&&INIT=,&&LABEL=;
  3615.    GBLA &&LACCT,&&LINIT;
  3616.    GBLC &&SITE,&&INITNAM,&&ACCTNAM;
  3617.  
  3618.    &&L: SYSLBL;
  3619.    ASM CASE '&SITE';
  3620.       'NIH': BEGIN
  3621.          CASE &® MAX 12;
  3622.             0: BEGIN
  3623.                FLAGSEG2 &&VAREA,&&LABEL;
  3624.                FLAGSEG1 &&VAREA,'PLEASE CONTACT THE PAL UNIT '_
  3625.                'AS SOON AS POSSIBLE DURING REGULAR HOURS';
  3626.                END;
  3627.             4: BEGIN
  3628.                FLAGSEG2 &&VAREA,&&LABEL;
  3629.                FLAGSEG1 &&VAREA,'FOR AN IMPORTANT MESSAGE REGARDING '_
  3630.                '&INITNAM ';
  3631.                FLAGSEG1 &&VAREA,&&INIT,&&LINIT,DEBLANK=YES;
  3632.                END;
  3633.             8: BEGIN
  3634.                FLAGSEG2 &&VAREA,&&LABEL;
  3635.                FLAGSEG1 &&VAREA,'TELEPHONE (301) 496-5525 '_
  3636.                'OR SUBMIT A "CRITICAL" PTR USING THE PTR COMMAND,'_
  3637.                ' GIVING A PHONE NUMBER WHERE YOU CAN BE REACHED';
  3638.                END;
  3639.             12: BEGIN
  3640.                LTR &®,&®  % SET NON-ZERO CC
  3641.                EXIT;  % DO NOT BUMP REGISTER
  3642.                END;
  3643.             ENDCASE
  3644.          THEN BEGIN
  3645.             AI &®,4;  % BUMP TO NEXT CASE
  3646.             CR &®,&®  % SET ZERO CC
  3647.             END;
  3648.          END;
  3649.       ENDCASE
  3650.    ELSE BEGIN
  3651.       CLI *,0;  % SET NON-ZERO CC
  3652.       END;
  3653.    MEND;
  3654. BAL;
  3655. ./       ADD   LIST=ALL,NAME=FLAGSEG1
  3656. ALP;
  3657.  
  3658. MACRO &&L: FLAGSEG1 &&VA,&&LOC,&&LEN,&&DEBLANK=;
  3659.    &&L: SYSLBL;
  3660.    ASM IF ('&VA' EQ '') THEN TSEG &&LOC,&&LEN,DEBLANK=&&DEBLANK
  3661.    ELSE VSEG &&VA,&&LOC,&&LEN,DEBLANK=&&DEBLANK;
  3662.    MEND;
  3663. BAL;
  3664. ./       ADD   LIST=ALL,NAME=FLAGSEG2
  3665. ALP;
  3666.  
  3667. MACRO &&L: FLAGSEG2 &&VAREA,&&LABEL;
  3668.    &&L: SYSLBL;
  3669.    ASM IF ('&LABEL' EQ '') THEN MEXIT;
  3670.    ASM CASE '&LABEL(1)';
  3671.       '': FLAGSEG1 &&VAREA,&&LABEL(2),&&LABEL(3);
  3672.       'MMSGINIT': MMSGINIT &&LABEL(2);
  3673.       'WMSGINIT': WMSGINIT &&LABEL(2);
  3674.       ENDCASE
  3675.    ELSE BEGIN
  3676.       BAL;
  3677.  &LABEL(1) &LABEL(2),&LABEL(3)
  3678.       ALP;
  3679.       END;
  3680.    MEND;
  3681. BAL;
  3682. ./       ADD   LIST=ALL,NAME=FREESWAM
  3683. ALP;
  3684.  
  3685. MACRO &&L: FREESWAM &&TCB=,&&ASCB=,&&SAVEXRA=,&&SAVEXRB=,_
  3686. &&SAVEXRC=,&&SAVER7=,&&R7=;
  3687.    GBLC &&OS;
  3688.  
  3689.    ASM CASE '&OS';
  3690.       'MVS','XA': BEGIN
  3691.          &&L:
  3692.          L VRF,&&TCB;  % ADDRESS OF TCB
  3693.          L VR1,TCBSWASA-TCB(VRF);  % GET ADDR OF SWA MGR SAVE AREA
  3694.          IF <RNZ VR1> & ^<C VRF,TCBJSTCB-TCB(VRF)> THEN BEGIN
  3695.             SYSLR &&SAVEXRA,(XRA);  % SAVE REGISTER 2
  3696.             SYSCMP XRA,EQ,2;
  3697.             MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=(2);  % KEY 0
  3698.             SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=USE,RELATED=*;
  3699.             SYSLR &&SAVEXRB,(XRB);  % SAVE REGISTERS USED BY FREEMAIN
  3700.             SYSLR &&SAVEXRC,(XRC);
  3701.             SYSLR &&SAVER7,(&&R7);
  3702.             L &&R7,&&ASCB;  % ASCB ADDRESS FOR FREEMAIN
  3703.             SYSCMP &&R7,EQ,7;
  3704.             SYSCMP &&R7,NE,BASER;
  3705.             L XRC,&&TCB;  % TCB ADDRESS FOR FREEMAIN
  3706.             SYSCMP XRC,EQ,4;
  3707.             L VR1,TCBSWASA-TCB(XRC);  % AREA TO FREE
  3708.             Z VR0,TCBSWASA-TCB(XRC);  % CLEAR POINTER IN TCB
  3709.             L VRF,0(,VR1);  % LENGTH AND SUBPOOL TO FREE
  3710.             ZR VRE; SLDL VRE,8; SRL VRF,8;  % SPLIT SUBPOOL AND LENGTH
  3711.             FREEMAIN RU,A=(1),LV=(VRF),SP=(VRE),KEY=1,BRANCH=YES;
  3712.             SYSCMP XRB,EQ,3;
  3713.             SYSLR XRB,(&&SAVEXRB);
  3714.             SYSLR XRC,(&&SAVEXRC);
  3715.             SYSLR &&R7,(&&SAVER7);
  3716.             SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
  3717.             MODESET KEYREG=XRA;  % RESTORE KEY
  3718.             SYSLR XRA,(&&SAVEXRA);  % RESTORE REGISTER 2
  3719.             END;
  3720.          END;
  3721.       ENDCASE
  3722.    ELSE <&&L: SYSLBL>;
  3723.    MEND;
  3724. BAL;
  3725. ./       ADD   LIST=ALL,NAME=GBLSET
  3726. ALP;
  3727.  
  3728. MACRO &&L: GBLSET;
  3729.    GBLC &&CPU,&&MP,&&OS;
  3730.    LCLA &&X;
  3731.  
  3732.    &&L: SYSLBL;
  3733.  
  3734.    ASM FOR &&X FROM 1 TO N'&&SYSLIST DO BEGIN
  3735.       ASM CASE '&SYSLIST(&X,1)';
  3736.          'CPU': BEGIN
  3737.             &&CPU: SETC '&SYSLIST(&X,2)';
  3738.             SYSKWT &&&&CPU,&&CPU,(360,370),COND=NO,NULL=NO;
  3739.             END;
  3740.          'MP': BEGIN
  3741.             &&MP: SETC '&SYSLIST(&X,2)';
  3742.             SYSKWT &&&&MP,&&MP,(YES,NO),COND=NO,NULL=NO;
  3743.             END;
  3744.          'OS': BEGIN
  3745.             &&OS: SETC '&SYSLIST(&X,2)';
  3746.             SYSKWT &&&&OS,&&OS,(MFT,MVT,VS1,SVS,MVS,XA),_
  3747.             COND=NO,NULL=NO;
  3748.             END;
  3749.          ENDCASE
  3750.       ELSE MNOTE 12,'"&SYSLIST(&X,1)" IS ILLEGAL';
  3751.       END;
  3752.  
  3753.    MEND;
  3754. BAL;
  3755. ./       ADD   LIST=ALL,NAME=IPRIVSCN
  3756. ALP;
  3757.  
  3758. MACRO &&L: IPRIVSCN &&BYTE,&&TYPE=;
  3759.    LCLC &&LBL;
  3760.    &&LBL: SETC 'ISCN&SYSNDX';
  3761.  
  3762.    SYSKWT TYPE,&&TYPE,(NO),COND=NO;
  3763.  
  3764.    &&L: SYSLBL;
  3765.    BEGIN SCAN *;
  3766.       SCKW &&TYPE.SYSTEMS,&&LBL,CODE=AL1(KWRIFSPR);
  3767.       SCKW &&TYPE.ACCOUNTING,&&LBL,CODE=AL1(KWRIFAPR);
  3768.       SCKW &&TYPE.OPERATOR,&&LBL,CODE=AL1(KWRIFOPR);
  3769.       SCKW &&TYPE.BASIC,&&LBL,CODE=AL1(KWRIFBPR);
  3770.       SCKW &&TYPE.UNDER,&&LBL,CODE=AL1(KWRIFUPR);
  3771.       SCKW &&TYPE.PROJECT,&&LBL,CODE=AL1(KWRIFPRJ);
  3772.       SCKW &&TYPE.FLAG,&&LBL,CODE=AL1(KWRIFFLG);
  3773.       SCKW ,*,B;
  3774.  
  3775.       &&LBL:
  3776.       ASM IF ('&TYPE' EQ 'NO')
  3777.       THEN <X VRE,=XL4'FF'; EXI VRE,NI,&&BYTE,0>
  3778.       ELSE EXI VRE,OI,&&BYTE,0;
  3779.       SCANEND; END;
  3780.    MEND;
  3781. BAL;
  3782. ./       ADD   LIST=ALL,NAME=IPRIVSEG
  3783. ALP;
  3784.  
  3785. MACRO &&L: IPRIVSEG &&BYTE,&&BEFORE=,&&AFTER=,&&VAREA=;
  3786.  
  3787.    &&L: SYSLBL;
  3788.    SELECT;
  3789.       <TM &&BYTE,KWRIFSPR>: BEGIN
  3790.          IPRIVSG1 'SYSTEMS',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3791.          END;
  3792.       <TM &&BYTE,KWRIFAPR>: BEGIN
  3793.       IPRIVSG1 'ACCOUNTING',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3794.          END;
  3795.       <TM &&BYTE,KWRIFOPR>: BEGIN
  3796.         IPRIVSG1 'OPERATOR',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3797.          END;
  3798.       <TM &&BYTE,KWRIFBPR>: BEGIN
  3799.          IPRIVSG1 'BASIC',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3800.          END;
  3801.       <TM &&BYTE,KWRIFUPR>: BEGIN
  3802.          IPRIVSG1 'UNDER',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3803.          END;
  3804.       <TM &&BYTE,KWRIFPRJ>: BEGIN
  3805.          IPRIVSG1 'PROJECT',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3806.          END;
  3807.       <TM &&BYTE,KWRIFFLG>: BEGIN
  3808.          IPRIVSG1 'FLAG',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3809.          END;
  3810.       ENDSEL;
  3811.    MEND;
  3812. BAL;
  3813. ./       ADD   LIST=ALL,NAME=IPRIVSG1
  3814. ALP;
  3815.  
  3816. MACRO &&L: IPRIVSG1 &&STRING,&&BEFORE=,&&AFTER=,&&VAREA=;
  3817.    &&L: SYSLBL;
  3818.    ASM IF ('&BEFORE' NE '')
  3819.    THEN IPRIVSG2 &&VAREA,&&BEFORE(1),&&BEFORE(2);
  3820.    IPRIVSG2 &&VAREA,&&STRING(1),&&STRING(2);
  3821.    ASM IF ('&AFTER' NE '')
  3822.    THEN IPRIVSG2 &&VAREA,&&AFTER(1),&&AFTER(2);
  3823.    MEND;
  3824. BAL;
  3825. ./       ADD   LIST=ALL,NAME=IPRIVSG2
  3826. ALP;
  3827.  
  3828. MACRO &&L: IPRIVSG2 &&VAREA,&&A,&&N;
  3829.    &&L: SYSLBL;
  3830.    ASM IF ('&VAREA' EQ '')
  3831.    THEN TSEG &&A,&&N
  3832.    ELSE VSEG &&VAREA,&&A,&&N;
  3833.    MEND;
  3834. BAL;
  3835. ./       ADD   LIST=ALL,NAME=KWR2
  3836.          MACRO
  3837.          KWR2
  3838.          GBLA  &LINIT,&LACCT,&LKW
  3839. *
  3840. *  NIH/COMMON - KEYWORD RECORD
  3841. *
  3842. *
  3843. *    OPERATION CODES
  3844. *
  3845. KWRCWR   EQU   X'80'                   WRITE
  3846. KWRCRD   EQU   X'40'                   READ
  3847. KWRCRDNA EQU   X'20'                   READ NEXT ACCOUNT
  3848. KWRCRDNI EQU   X'10'                   READ NEXT INITIALS
  3849. KWRCALL  EQU   X'08'                   READ WHOLE LRECD
  3850. KWRCLONG EQU   X'04'                   8-BYTE KW, 4-BYTE INITIALS
  3851. KWRC31   EQU   X'02'                   PARM LIST FOR 31 BIT MODE
  3852. KWRCXTND EQU   X'01'                   EXTENDED AREAS USED
  3853. *
  3854. *
  3855. KWRSTART DS    0F
  3856. KWRACCT  DCC   CL&LACCT'AAAA',LENGTH=&LACCT  ACCOUNT NO.
  3857. KWRINIT  DCC   CL&LINIT'ABC',LENGTH=&LINIT  INITIALS
  3858. KWRKW    DCC   CL&LKW'XXX',LENGTH=&LKW  KEYWORD
  3859. KWRHFL   DC    X'00'                   HASP STATUS FLAGS
  3860. *
  3861. KWRHFCK  EQU   X'80'                   KEYWORD CHECKING IN EFFECT
  3862. KWRHFUOK EQU   X'40'                   UPDATE SUCCESSFUL
  3863. KWRHFROK EQU   X'40'                   READ SUCCESSFUL
  3864. KWRHFREJ EQU   X'20'                   REQUEST REJECTED (INVALID)
  3865. KWRHFIVI EQU   X'10'                   INVALID INITIALS
  3866. KWRHFIVA EQU   X'08'                   INVALID ACCOUNT
  3867. *
  3868. KWRIFL   DC    AL1(KWRIFVAL)           INITIALS FLAGS
  3869. *
  3870. KWRIFVAL EQU   X'80'                   VALID
  3871. KWRIFSPR EQU   X'40'                   SYSTEM PRIVILIGE
  3872. KWRIFAPR EQU   X'20'                   ACCOUNT PRIVILIGE
  3873. KWRIFOPR EQU   X'10'                   OPERATOR PRIVILIGE
  3874. KWRIFUPR EQU   X'08'                   UNDERPRIVILIGED
  3875. KWRIFPRJ EQU   X'04'                   PROJECT
  3876. KWRIFBPR EQU   X'02'                   BASIC PRIVILEGE
  3877. KWRIFFLG EQU   X'01'                   CONTACT USER SERVICES FLAG
  3878. KWRIFRSV EQU   X'00'                   RESERVED BITS
  3879. *
  3880. KWRAFL   DC    AL1(KWRAFVAL)           ACCOUNT FLAGS
  3881. *
  3882. KWRAFVAL EQU   X'80'                   VALID
  3883. KWRAFFLG EQU   X'40'                   CONTACT USER SERVICES (OBSOLETE)
  3884. KWRAFCIB EQU   X'20'                   CHECK KW IN BATCH  (OBSOLETE)
  3885. KWRAFMB  EQU   X'10'                   MAIL BOX ACCOUNT
  3886. KWRAFMP  EQU   X'08'                   MAIL PENDING
  3887. KWRAFPRO EQU   X'04'                   WYLBUR PROFILE EXISTS
  3888. KWRAFRCM EQU   X'02'                   WYLBUR RECOVERY - MILTEN
  3889. KWRAFRCT EQU   X'01'                   WYLBUR RECOVERY - TSO
  3890. KWRAFRSV EQU   X'00'+KWRAFCIB+KWRAFFLG RESERVED BITS
  3891. *
  3892. KWRPTR   DS    0AL3                    OLD NAME
  3893. KWRRSV   DC    X'000000'               FOR FUTURE USE
  3894.          DS    0F
  3895. KWRSIZE  EQU   *-KWRSTART
  3896. *
  3897. *        EXTENDED AREA
  3898. *
  3899. KWRIEXT  DS    XL24'00'                FOR FUTURE USE
  3900. KWRAEXT  DS    XL9'00'                 FOR FUTURE USE
  3901. KWREKW   DC    CL8' '                  LONG KW
  3902. KWREINIT DC    CL4' '                  LONG INITIALS
  3903. KWRESIZE EQU   *-KWRSTART
  3904.          MEND
  3905. ./       ADD   LIST=ALL,NAME=LI
  3906.          MACRO
  3907. &L       LI    &R,&V
  3908.          LCLA  &X
  3909. .*
  3910. .LOOP    ANOP
  3911. &X       SETA  &X+1
  3912.          AIF   (&X GT K'&V).INT
  3913.          AIF   ('&V'(&X,1) GE '0' AND '&V'(&X,1) LE '9').LOOP
  3914. .*
  3915. .LA      ANOP
  3916. &L       LA    &R,&V
  3917.          MEXIT
  3918. .*
  3919. .INT     ANOP
  3920.          AIF   (&V LT 4096).LA
  3921. &L       L     &R,=F'&V'
  3922.          MEND
  3923. ./       ADD   LIST=ALL,NAME=LQS
  3924.          MACRO
  3925. &L       LQS   &R,&S,&QS,&N
  3926. &L       SYSQS &R,&S,&QS,&N
  3927.          MEND
  3928. ./       ADD   LIST=ALL,NAME=LOADB
  3929.          MACRO
  3930. &L       LOADB &R,&A,&JUNK=
  3931.          SYSKWT JUNK,&JUNK,(OK,YES)
  3932.          AIF   ('&JUNK' NE '').JUNK
  3933. &L       SLR   &R,&R
  3934.          IC    &R,&A
  3935.          MEXIT
  3936. .JUNK    ANOP
  3937. &L       IC    &R,&A
  3938.          MEND
  3939. ./       ADD   LIST=ALL,NAME=LOADF
  3940.          MACRO
  3941. &L       LOADF &R,&A,&JUNK=
  3942.          GBLC  &CPU,&SIM370
  3943.          SYSKWT JUNK,&JUNK,(OK,YES)
  3944.          AIF   ('&CPU' EQ '360').S360
  3945. &L       UAOP  L,&R,&A
  3946.          MEXIT
  3947. .S360    ANOP
  3948. &L       MMVC  &SIM370,&A,4
  3949.          L     &R,&SIM370
  3950.          MEND
  3951. ./       ADD   LIST=ALL,NAME=LOADH
  3952.          MACRO
  3953. &L       LOADH &R,&A,&JUNK=
  3954.          GBLC  &CPU,&SIM370
  3955.          SYSKWT JUNK,&JUNK,(OK,YES)
  3956.          AIF   ('&CPU' EQ '360').S360
  3957. &L       UAOP  LH,&R,&A
  3958.          MEXIT
  3959. .S360    ANOP
  3960. &L       MMVC  &SIM370,&A,2
  3961.          LH    &R,&SIM370
  3962.          MEND
  3963. ./       ADD   LIST=ALL,NAME=LOADLF
  3964.          MACRO
  3965. &L       LOADLF &R,&A,&JUNK=
  3966. &L       LOADF &R,&A,JUNK=&JUNK
  3967.          MEND
  3968. ./       ADD   LIST=ALL,NAME=LOADLH
  3969.          MACRO
  3970. &L       LOADLH &R,&A,&JUNK=
  3971.          GBLC  &CPU,&SIM370
  3972.          SYSKWT JUNK,&JUNK,(OK,YES)
  3973.          AIF   ('&CPU' EQ '360').S360
  3974.          AIF   ('&JUNK' NE '').J370
  3975. &L       SLR   &R,&R
  3976.          ICM   &R,3,&A
  3977.          MEXIT
  3978. .J370    ANOP
  3979. &L       ICM   &R,3,&A
  3980.          MEXIT
  3981. .S360    ANOP
  3982. &L       MMVC  4*2+2+&SIM370,&A,2
  3983.          L     &R,4*2+&SIM370
  3984.          MEND
  3985. ./       ADD   LIST=ALL,NAME=LOADP
  3986.          MACRO
  3987. &L       LOADP &R,&A,&JUNK=
  3988.          GBLC  &CPU,&SIM370
  3989.          SYSKWT JUNK,&JUNK,(OK,YES)
  3990.          AIF   ('&CPU' EQ '360').S360
  3991.          AIF   ('&JUNK' NE '').J370
  3992. &L       SLR   &R,&R
  3993.          ICM   &R,7,&A
  3994.          MEXIT
  3995. .J370    ANOP
  3996. &L       ICM   &R,7,&A
  3997.          MEXIT
  3998. .S360    ANOP
  3999. &L       MMVC  4*1+1+&SIM370,&A,3
  4000.          L     &R,4*1+&SIM370
  4001.          MEND
  4002. ./       ADD   LIST=ALL,NAME=LT
  4003.          MACRO
  4004. &L       LT    &R,&A
  4005. &L       L     &R,&A
  4006.          LTR   &R,&R
  4007.          MEND
  4008. ./       ADD   LIST=ALL,NAME=MCCW
  4009.          MACRO
  4010. &L       MCCW  &OP,&A,&F,&N,&CODE=0
  4011. &L       CCW   &OP,&A,&F,&N
  4012.          AIF   ('&CODE' EQ '' OR '&CODE' EQ '0').END
  4013.          ORG   *-3
  4014.          DC    AL1(&CODE)
  4015.          ORG   *+2
  4016. .END     MEND
  4017. ./       ADD   LIST=ALL,NAME=MCLC
  4018.          MACRO
  4019. &L       MCLC  &A,&B,&C,&N=*,&ZERO=
  4020.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  4021.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  4022. &L       SYSXXC CLC,&A,&B,&C,N=&N,BC=BNE
  4023.          MEXIT
  4024. .*
  4025. .NULL    ANOP
  4026. &L       CLI   *+1,0
  4027.          MEND
  4028. ./       ADD   LIST=ALL,NAME=MCLCL
  4029.          MACRO
  4030. &L       MCLCL &RA,&AA,&LA,&RB,&AB,&LB,&FILL=0,&FILADDR=,&INLINE=,&N=*
  4031.          GBLC  &CPU
  4032.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  4033.          AIF   ('&CPU' EQ '360').S360
  4034. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4035.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  4036.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4037.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ370
  4038.          AIF   ('&LB' EQ '(&RA+1)' OR '&LA' EQ '(&RB+1)').EQ370
  4039.          SYSLR &RB+1,&LB
  4040.          AIF   ('&FILADDR' NE '').FILADDR
  4041.          AIF   ('&FILL' EQ '0').Z370
  4042.          O     &RB+1,=AL1(&FILL,0,0,0)
  4043.          AGO   .Z370
  4044. .*
  4045. .FILADDR ANOP
  4046.          ICM   &RB+1,8,&FILADDR
  4047. .Z370    CLCL  &RA,&RB
  4048.          MEXIT
  4049. .EQ370   ANOP
  4050.          LR    &RB+1,&RA+1
  4051.          CLCL  &RA,&RB
  4052.          MEXIT
  4053. .*
  4054. .*  360 LOOP
  4055. .*
  4056. .S360    ANOP
  4057.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ360
  4058. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4059.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  4060.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4061.          SYSLR &RB+1,&LB
  4062. &L       SR    &RA+1,&RB+1
  4063.          BNM   *+8
  4064.          AR    &RB+1,&RA+1
  4065.          SLR   &RA+1,&RA+1
  4066.          AIF  ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').NE360AZ
  4067.          AIF  ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').NE360BZ
  4068.          LTR   &RB+1,&RB+1
  4069.          BNP   CLC&SYSNDX.A
  4070.          MCLCLC &RA,&RB,&RB+1,CLC&SYSNDX.B
  4071.          LA    &RA,1(&RA,&RB+1)
  4072. CLC&SYSNDX.A LTR &RA+1,&RA+1
  4073.          BNP   CLC&SYSNDX.B
  4074.          MCLCLF &RA,&RA+1,CLC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
  4075. CLC&SYSNDX.B DS 0H
  4076.          MEXIT
  4077. .*
  4078. .NE360AZ ANOP
  4079.          XR    &RA,&RA+1
  4080.          XR    &RA+1,&RA
  4081.          XR    &RA,&RA+1
  4082.          LTR   &RB+1,&RB+1
  4083.          BNP   CLC&SYSNDX.A
  4084.          MCLCLC &RA+1,&RB,&RB+1,CLC&SYSNDX.B
  4085.          LA    &RA+1,1(&RA+1,&RB+1)
  4086. CLC&SYSNDX.A LTR &RB+1,&RA
  4087.          BNP   CLC&SYSNDX.B
  4088.          MCLCLF &RA+1,&RB+1,CLC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
  4089. CLC&SYSNDX.B DS 0H
  4090.          MEXIT
  4091. .*
  4092. .NE360BZ ANOP
  4093.          XR    &RB,&RA+1
  4094.          XR    &RA+1,&RB
  4095.          XR    &RB,&RA+1
  4096.          LTR   &RB+1,&RB+1
  4097.          BNP   CLC&SYSNDX.A
  4098.          MCLCLC &RA,&RA+1,&RB+1,CLC&SYSNDX.B
  4099.          LA    &RA,1(&RA,&RB+1)
  4100. CLC&SYSNDX.A LTR &RB+1,&RB
  4101.          BNP   CLC&SYSNDX.B
  4102.          MCLCLF &RA,&RB+1,CLC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
  4103. CLC&SYSNDX.B DS 0H
  4104.          MEXIT
  4105. .*
  4106. .*  360 EQUAL LENGTH
  4107. .*
  4108. .EQ360   ANOP
  4109.          AIF   ('&INLINE' EQ 'YES').INLINE
  4110.          AIF  ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').EQ360AZ
  4111.          AIF  ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').EQ360BZ
  4112. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4113.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4114.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4115.          BNP   CLC&SYSNDX.A
  4116.          MCLCLC &RA,&RB,&RA+1,CLC&SYSNDX.A
  4117. CLC&SYSNDX.A DS 0H
  4118.          MEXIT
  4119. .*
  4120. .EQ360AZ ANOP
  4121. &L       SYSLR &RB+1,&AA
  4122.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4123.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4124.          BNP   CLC&SYSNDX.A
  4125.          MCLCLC &RB+1,&RB,&RA+1,CLC&SYSNDX.A
  4126. CLC&SYSNDX.A DS 0H
  4127.          MEXIT
  4128. .*
  4129. .EQ360BZ ANOP
  4130. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4131.          SYSLR &RB+1,&AB
  4132.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4133.          BNP   CLC&SYSNDX.A
  4134.          MCLCLC &RA,&RB+1,&RA+1,CLC&SYSNDX.A
  4135. CLC&SYSNDX.A DS 0H
  4136.          MEXIT
  4137. .*
  4138. .*  INLINE
  4139. .*
  4140. .INLINE  ANOP
  4141. &L       MCLC  &AA,&AB,&LA,N=&N
  4142.          MEND
  4143. ./       ADD   LIST=ALL,NAME=MCLCLC
  4144.          MACRO
  4145. &L       MCLCLC &A,&B,&C,&LEND
  4146.          LCLC  &LBL
  4147. .*
  4148. &LBL     SETC  '&L'
  4149.          AIF   ('&L' NE '').OKLBL
  4150. &LBL     SETC  'CLC&SYSNDX.X'
  4151. .OKLBL   ANOP
  4152. .*
  4153. &LBL     C     &C,=F'256'
  4154.          BNH   CLC&SYSNDX.Z
  4155.          CLC   0(256,&A),0(&B)
  4156.          BNE   &LEND
  4157.          LA    &A,256(,&A)
  4158.          LA    &B,256(,&B)
  4159.          S     &C,=F'256'
  4160.          B     &LBL
  4161. CLC&SYSNDX.Y CLC 0(0,&A),0(&B)
  4162. CLC&SYSNDX.Z BCTR &C,0
  4163.          EX    &C,CLC&SYSNDX.Y
  4164.          MEND
  4165. ./       ADD   LIST=ALL,NAME=MCLCLF
  4166.          MACRO
  4167. &L       MCLCLF &A,&C,&LEND,&FILL=0,&FILADDR=
  4168. .*
  4169.          AIF   ('&FILADDR' EQ '').FILL
  4170. &L       CLC   0(1,&A),&FILADDR
  4171.          AGO   .BNE
  4172. .*
  4173. .FILL    ANOP
  4174. &L       CLI   0(&A),&FILL
  4175. .BNE     BNE   &LEND
  4176.          BCTR  &C,0
  4177.          LTR   &C,&C
  4178.          BNP   &LEND
  4179. CLC&SYSNDX.P C &C,=F'256'
  4180.          BNH   CLC&SYSNDX.R
  4181.          CLC   1(256,&A),0(&A)
  4182.          BNE   &LEND
  4183.          LA    &A,256(,&A)
  4184.          S     &C,=F'256'
  4185.          B     CLC&SYSNDX.P
  4186. CLC&SYSNDX.Q CLC 1(0,&A),0(&A)
  4187. CLC&SYSNDX.R BCTR &C,0
  4188.          EX    &C,CLC&SYSNDX.Q
  4189.          MEND
  4190. ./       ADD   LIST=ALL,NAME=MDC
  4191.          MACRO
  4192.          MDC
  4193. *
  4194. *  MACHINE DEPENDENT CELLS
  4195. *
  4196. EXOLDPSW EQU   24                      EXTERNAL OLD PSW
  4197. SVOLDPSW EQU   32                      SVC OLD PSW
  4198. PIOLDPSW EQU   40                      PROGRAM OLD PSW
  4199. MKOLDPSW EQU   48                      MACHINE CHECK OLD PSW
  4200. IOOLDPSW EQU   56                      I/O OLD PSW
  4201. CSW      EQU   64                      CHANNEL STATUS WORD
  4202. CSWKEY   EQU   64                      PROTECT KEY PORTION
  4203. CSWADDR  EQU   65                      ADDRESS PORTION OF CSW
  4204. CSWSTAT  EQU   68                      STATUS BYTES
  4205. *
  4206. CSWSATTN EQU   X'80'                   ATTENTION
  4207. CSWSSM   EQU   X'40'                   STATUS MODIFIER
  4208. CSWSCUE  EQU   X'20'                   CONTROL UNIT END
  4209. CSWSBUSY EQU   X'10'                   CONTROL UNIT BUSY
  4210. CSWSCE   EQU   X'08'                   CHANNEL END
  4211. CSWSDE   EQU   X'04'                   DEVICE END
  4212. CSWSUC   EQU   X'02'                   UNIT CHECK
  4213. CSWSUE   EQU   X'01'                   UNIT EXCEPTION
  4214. *
  4215. CSWSTAT2 EQU   69                      2ND STATUS BYTE
  4216. *
  4217. CSWSPCI  EQU   X'80'                   PCI
  4218. CSWSIL   EQU   X'40'                   INCORRECT LENGTH
  4219. CSWSPC   EQU   X'20'                   PROGRAM CHECK
  4220. CSWSSPC  EQU   X'10'                   STORAGE PROTECTION CHECK
  4221. CSWSCDC  EQU   X'08'                   CHANNEL DATA CHECK
  4222. CSWSCCC  EQU   X'04'                   CHANNEL CONTROL CHECK
  4223. CSWSICC  EQU   X'02'                   INTERFACE CONTROL CHECK
  4224. CSWSCC   EQU   X'01'                   CHAINING CHECK
  4225. *
  4226. CSWLEN   EQU   70                      UNUSED LENGTH
  4227. CAW      EQU   72                      CHANNEL ADDRESS WORD
  4228. INTTIMER EQU   80                      INTERVAL TIMER
  4229. EXNEWPSW EQU   88                      EXTERNAL NEW PSW
  4230. SVNEWPSW EQU   96                      SVC NEW PSW
  4231. PINEWPSW EQU   104                     PROGRAM NEW PSW
  4232. MKNEWPSW EQU   112                     MACHINE CHECK NEW PSW
  4233. IONEWPSW EQU   120                     I/O NEW PSW
  4234. DSCANA   EQU   128                     DIAGNOSTIC SCAN-OUT AREA
  4235. *
  4236. *  CCW DEFINITIONS
  4237. *
  4238. CCWCC    EQU   0                       COMMAND CODE
  4239. *
  4240. CCWCNOP  EQU   X'03'                   NO OPERATION
  4241. CCWCTIC  EQU   X'08'                   TRANSFER IN CHANNEL
  4242. CCWCSNS  EQU   X'04'                   SENSE
  4243. *
  4244. CCWADDR  EQU   1                       ADDRESS
  4245. CCWFL    EQU   4                       FLAGS
  4246. *
  4247. CCWFDCH  EQU   X'80'                   DATA CHAINING BIT
  4248. CCWFCCH  EQU   X'40'                   COMMAND CHAINING BIT
  4249. CCWFSLI  EQU   X'20'                   SUPPRESS INCORRECT LENGTH BIT
  4250. CCWFSKIP EQU   X'10'                   SUPPRESS DATA TRANSFER BIT
  4251. CCWFPCI  EQU   X'08'                   PROGRAM CONTROLLED INTERRUPT
  4252. CCWFIDA  EQU   X'04'                   INDIRECT DATA ADDRESS
  4253. *
  4254. CCWLEN   EQU   6                       LENGTH
  4255. *
  4256. *  SENSE BYTES
  4257. *
  4258. SNSBYTE1 EQU   0                       SENSE BYTE 1
  4259. *
  4260. SNSBCR   EQU   X'80'                   COMMAND REJECT
  4261. SNSBIR   EQU   X'40'                   INTERVENTION REQUIRED
  4262. SNSBBOPC EQU   X'20'                   BUS OUT PARITY CHECK
  4263. SNSBEC   EQU   X'10'                   EQUIPMENT CHECK
  4264. SNSBDC   EQU   X'08'                   DATA CHECK
  4265. SNSBOR   EQU   X'04'                   OVERRUN
  4266. SNSBLD   EQU   X'02'                   LOST DATA
  4267. SNSBTO   EQU   X'01'                   TIMEOUT
  4268. *
  4269. *  EBCDIC CONTROL CHARACTERS
  4270. *
  4271. EBCNUL   EQU   X'00'           ASCII   NULL
  4272. EBCSOH   EQU   X'01'           ASCII   SOH
  4273. EBCSTX   EQU   X'02'           ASCII   STX
  4274. EBCETX   EQU   X'03'           ASCII   ETX
  4275. EBCEDI   EQU   X'04'  (1)      MILTEN  END DIM INTENSITY
  4276. EBCPF    EQU   X'04'  (2)      IBM     PUNCH OFF
  4277. EBCHT    EQU   X'05'           ASCII   HORIZONTAL TAB
  4278. EBCEBC   EQU   X'06'  (1)      MILTEN  END BOLD CHARACTERS
  4279. EBCLC    EQU   X'06'  (2)      IBM     LOWER CASE
  4280. EBCDEL   EQU   X'07'           ASCII   DELETE
  4281. EBCGE    EQU   X'08'           IBM     GRAPHIC ESCAPE
  4282. EBCRLF   EQU   X'09'           IBM     REVERSE LINE FEED
  4283. EBCSTOP  EQU   X'0A'  (1)      MILTEN  STOP CODE
  4284. EBCSMM   EQU   X'0A'  (2)      IBM     START OF MANUAL MESSAGE
  4285. EBCVT    EQU   X'0B'           ASCII   VERTICAL TAB
  4286. EBCFF    EQU   X'0C'           ASCII   FORM FEED
  4287. EBCCR    EQU   X'0D'           ASCII   CARRIAGE RETURN
  4288. EBCSO    EQU   X'0E'           ASCII   SHIFT OUT
  4289. EBCSI    EQU   X'0F'           ASCII   SHIFT IN
  4290. EBCDLE   EQU   X'10'           ASCII   DATA LINK ESCAPE
  4291. EBCDC1   EQU   X'11'           ASCII   DEVICE CONTROL 1
  4292. EBCDC2   EQU   X'12'           ASCII   DEVICE CONTROL 2
  4293. EBCSVF   EQU   X'13'  (1)      MILTEN  START OF VARIABLE FIELD
  4294. EBCTM    EQU   X'13'  (2)      IBM     TAPE MARK
  4295. EBCEVF   EQU   X'14'  (1)      MILTEN  END OF VARIABLE FIELD
  4296. EBCRES   EQU   X'14'  (2)      IBM     RESTORE
  4297. EBCNL    EQU   X'15'           IBM     NEW LINE
  4298. EBCBS    EQU   X'16'           ASCII   BACKSPACE
  4299. EBCIL    EQU   X'17'           IBM     IDLE CHARACTER
  4300. EBCCAN   EQU   X'18'           ASCII   CANCEL
  4301. EBCEM    EQU   X'19'           ASCII   END OF MEDIUM
  4302. EBCFONT  EQU   X'1A'  (1)      WYLBUR  SELECT NEW FONT
  4303. EBCCC    EQU   X'1A'  (2)      IBM     CURSOR CONTROL
  4304. EBCHLF   EQU   X'1B'  (1)      MILTEN  HALF LINE FEED
  4305. EBCCU1   EQU   X'1B'  (2)      IBM     CUSTOMER USE 1
  4306. EBCIFS   EQU   X'1C'           ASCII   INTERCHANGE FILE SEPARATOR
  4307. EBCIGS   EQU   X'1D'           ASCII   INTERCHANGE GROUP SEPARATOR
  4308. EBCIRS   EQU   X'1E'           ASCII   INTERCHANGE RECORD SEPARATOR
  4309. EBCIUS   EQU   X'1F'           ASCII   INTERCHANGE UNIT SEPARATOR
  4310. EBCNDBS  EQU   X'20'  (1)      MILTEN  NON-DESTRUCTIVE BACKSPACE
  4311. EBCDS    EQU   X'20'  (2)      IBM     DIGIT SELECT
  4312. EBCSOS   EQU   X'21'           IBM     START OF SIGNIFICANCE
  4313. EBCFS    EQU   X'22'           IBM     FIELD SEPARATOR (EDIT)
  4314. EBCCTB   EQU   X'23'           MILTEN  CLEAR TERMINAL BUFFER
  4315. EBCBYP   EQU   X'24'           IBM     BYPASS
  4316. EBCLF    EQU   X'25'           ASCII   LINE FEED
  4317. EBCETB   EQU   X'26'           ASCII   END OF TRANSMISSION BLOCK
  4318. EBCESC   EQU   X'27'           ASCII   ESCAPE
  4319. EBCHTS   EQU   X'28'           MILTEN  SET HORIZONTAL TAB
  4320. EBCHTCA  EQU   X'29'           MILTEN  CLEAR ALL HORIZONTAL TABS
  4321. EBCSUL   EQU   X'2A'  (1)      MILTEN  START UNDERLINE
  4322. EBCSM    EQU   X'2A'  (2)      IBM     SET MODE
  4323. EBCRHLF  EQU   X'2B'  (1)      MILTEN  REVERSE HALF LINE FEED
  4324. EBCCU2   EQU   X'2B'  (2)      IBM     CUSTOMER USE 2
  4325. EBCEUL   EQU   X'2C'           MILTEN  END UNDERLINE
  4326. EBCENQ   EQU   X'2D'           ASCII   ENQUIRY
  4327. EBCACK   EQU   X'2E'           ASCII   ACKNOWLEDGE
  4328. EBCBEL   EQU   X'2F'           ASCII   BELL
  4329. EBCVTS   EQU   X'30'           MILTEN  SET VERTICAL TAB
  4330. EBCVTCA  EQU   X'31'           MILTEN  CLEAR ALL VERTICAL TABS
  4331. EBCSYN   EQU   X'32'           ASCII   SYNCHRONOUS IDLE
  4332. EBCREN   EQU   X'33'           MILTEN  REENTER
  4333. EBCSDI   EQU   X'34'  (1)      MILTEN  START DIM INTENSITY
  4334. EBCPN    EQU   X'34'  (2)      IBM     PUNCH ON
  4335. EBCDC3   EQU   X'35'  (1)      ASCII   DEVICE CONTROL 3
  4336. EBCRS    EQU   X'35'  (2)      TSO     READER STOP
  4337. EBCSBC   EQU   X'36'  (1)      MILTEN  START BOLD CHARACTERS
  4338. EBCUC    EQU   X'36'  (2)      IBM     UPPER CASE
  4339. EBCEOT   EQU   X'37'           ASCII   END OF TRANSMISSION
  4340. EBCSRF   EQU   X'38'           MILTEN  START REVERSE FIELD
  4341. EBCERF   EQU   X'39'           MILTEN  END REVERSE FIELD
  4342. EBCSBK   EQU   X'3A'           MILTEN  START BLINK
  4343. EBCEBK   EQU   X'3B'  (1)      MILTEN  END BLINK
  4344. EBCCU3   EQU   X'3B'  (2)      IBM     CUSTOMER USE 3
  4345. EBCDC4   EQU   X'3C'           ASCII   DEVICE CONTROL 4
  4346. EBCNAK   EQU   X'3D'           ASCII   NEGATIVE ACKNOWLEDGE
  4347. EBCCTM   EQU   X'3E'           MILTEN  CLEAR TERMINAL MESSAGE
  4348. EBCSUB   EQU   X'3F'           ASCII   SUBSTITUTE
  4349. *
  4350. *  EBCDIC GRAPHIC CHARACTERS
  4351. *
  4352. EBCSP    EQU   X'40'           ASCII   SPACE
  4353. EBCDIGSP EQU   X'41'           MILTEN  DIGIT SPACE
  4354. EBCUNSP  EQU   X'42'           MILTEN  UNIT SPACE
  4355. EBCCENT  EQU   X'4A'           IBM     CENT SIGN
  4356. EBCIHYPH EQU   X'62'           MILTEN  INSERTED HYPHEN
  4357. EBCACCNT EQU   X'79'           ASCII   GRAVE ACCENT
  4358. EBCLCURL EQU   X'8B'           ASCII   LEFT CURLY BRACKET
  4359. EBCRCURL EQU   X'9B'           ASCII   RIGHT CURLY BRACKET
  4360. EBCPLMIN EQU   X'9E'           IBM     PLUS/MINUS SIGN
  4361. EBCDEGR  EQU   X'A1'  (1)      IBM     DEGREE MARK
  4362. EBCTILDE EQU   X'A1'  (2)      ASCII   TILDE
  4363. EBCLSQB  EQU   X'AD'           ASCII   LEFT SQUARE BRACKET
  4364. EBCRSQB  EQU   X'BD'           ASCII   RIGHT SQUARE BRACKET
  4365. EBCCFLEX EQU   X'BE'           ASCII   CIRCUMFLEX
  4366. EBCBKSL  EQU   X'E0'           ASCII   BACKSLASH
  4367.          MEND
  4368. ./       ADD   LIST=ALL,NAME=MFC
  4369.          MACRO
  4370. &L       MFC   &A,&C,&FILL=C' ',&FILADDR=,&N=*,&ZERO=
  4371.          LCLA  &X,&Y
  4372.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  4373.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  4374.         AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').Z
  4375. .*
  4376.          AIF   ('&C' NE '').NDLEN
  4377.          AIF  (T'&A NE 'M' AND T'&A NE 'N' AND T'&A NE 'O' AND         *
  4378.                T'&A NE 'T' AND T'&A NE 'U' AND T'&A NE 'W' AND         *
  4379.                T'&A NE '$').OKLEN
  4380.          MNOTE 12,'LENGTH NOT CODED AND LENGTH ATTRIBUTE NOT AVAILABLE'
  4381. &L       MFCMVI &A,&FILL,&FILADDR
  4382.          MEXIT
  4383. .*
  4384. .OKLEN   ANOP
  4385. &X       SETA  L'&A
  4386. &L       MFC   &A,&X,FILL=&FILL,FILADDR=&FILADDR,N=&N
  4387.          MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&X)'
  4388.          MEXIT
  4389. .*
  4390. .NDLEN   ANOP
  4391. .*
  4392. &L       MFCMVI &A,&FILL,&FILADDR
  4393.          AIF   ('&N' EQ '' OR '&N' EQ '*').STAR
  4394. .ONE     SYSXXC MVC,&A,&A,&C-1,D1=1,N=&N
  4395.          MEXIT
  4396. .*
  4397. .STAR    ANOP
  4398.          AIF   ('&C' EQ '').ONE
  4399. .CHECK   ANOP
  4400. &Y       SETA  &Y+1
  4401.          AIF   (&Y GT K'&C).OK
  4402.          AIF   ('&C'(&Y,1) LT '0').ONE
  4403.          AGO   .CHECK
  4404. .OK      ANOP
  4405. &X       SETA  &C-1
  4406.          AIF   (&X LE 0).END
  4407.          SYSXXC MVC,&A,&A,&X,D1=1,N=*
  4408.          MEXIT
  4409. .*
  4410. .Z       ANOP
  4411. &L       MXC   &A,&A,&C,N=&N
  4412.          MEXIT
  4413. .*
  4414. .NULL    ANOP
  4415. &L       SYSLBL
  4416. .END     MEND
  4417. ./       ADD   LIST=ALL,NAME=MFCMVI
  4418.          MACRO
  4419. &L       MFCMVI &A,&FILL,&FILADDR
  4420.          AIF   ('&FILADDR' NE '').FILADDR
  4421.          AIF   ('&A' EQ '').NREG
  4422.          AIF   ('&A'(1,1) NE '(').NREG
  4423. &L       MVI   0&A,&FILL
  4424.          MEXIT
  4425. .*
  4426. .NREG    ANOP
  4427. &L       MVI   &A,&FILL
  4428.          MEXIT
  4429. .*
  4430. .FILADDR ANOP
  4431. &L       MMVC  &A,&FILADDR,1
  4432.          MEND
  4433. ./       ADD   LIST=ALL,NAME=MFCL
  4434.          MACRO
  4435. &L       MFCL  &R,&A,&C,&S,&FILL=C' ',&FILADDR=,&INLINE=,&N=*
  4436.          GBLC  &CPU
  4437.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  4438.          AIF   ('&CPU' EQ '360').S360
  4439. &L       SYSLR &R,&A,ERR='ADDRESS REQUIRED'
  4440.          SYSLR &R+1,&C,ERR='LENGTH REQUIRED'
  4441.          LR    &S,&R
  4442.          AIF   ('&FILADDR' NE '').FILADDR
  4443.          AIF   ('&FILL' EQ '' OR '&FILL' EQ '0').Z370
  4444.          L     &S+1,=AL1(&FILL,0,0,0)
  4445.          AGO   .MMVCL
  4446. .*
  4447. .FILADDR ANOP
  4448.          SR    &S+1,&S+1
  4449.          ICM   &S+1,8,&FILADDR
  4450. .MMVCL   ANOP
  4451.          MVCL  &R,&S
  4452.          MEXIT
  4453. .*
  4454. .Z370    SLR   &S+1,&S+1
  4455.          MVCL  &R,&S
  4456.          MEXIT
  4457. .*
  4458. .*  360
  4459. .*
  4460. .S360    ANOP
  4461.          AIF   ('&INLINE' EQ 'YES').MFC
  4462.          AIF   ('&FILL' EQ '' OR '&FILL' EQ '0').Z360
  4463.          AIF   ('&R' EQ '0' OR '&R' EQ 'R0' OR '&R' EQ 'VR0').RZ360
  4464. &L       SYSLR &R,&A,ERR='ADDRESS REQUIRED'
  4465.          SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
  4466.          BNP   MFC&SYSNDX.A
  4467.          MFCLF &R,&R+1,MFC&SYSNDX.A,FILL=&FILL,FILADDR=&FILADDR
  4468. MFC&SYSNDX.A DS 0H
  4469.          MEXIT
  4470. .*
  4471. .RZ360   ANOP
  4472. &L       SYSLR &S,&A
  4473.          SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
  4474.          BNP   MFC&SYSNDX.A
  4475.          MFCLF &S,&R+1,MFC&SYSNDX.A,FILL=&FILL,FILADDR=&FILADDR
  4476. MFC&SYSNDX.A DS 0H
  4477.          MEXIT
  4478. .*
  4479. .*  360 CLEAR TO ZERO
  4480. .*
  4481. .Z360    ANOP
  4482.          AIF   ('&R' EQ '0' OR '&R' EQ 'R0' OR '&R' EQ 'VR0').ZRZ360
  4483. &L       SYSLR &R,&A,ERR='ADDRESS REQUIRED'
  4484.          SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
  4485.          BNP   MFC&SYSNDX.A
  4486.          MFCLZ &R,&R+1
  4487. MFC&SYSNDX.A DS 0H
  4488.          MEXIT
  4489. .*
  4490. .ZRZ360  ANOP
  4491. &L       SYSLR &S,&A
  4492.          SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
  4493.          BNP   MFC&SYSNDX.A
  4494.          MFCLZ &S,&R+1
  4495. MFC&SYSNDX.A DS 0H
  4496.          MEXIT
  4497. .*
  4498. .*  MFC
  4499. .*
  4500. .MFC     ANOP
  4501. &L       MFC   &A,&C,FILL=&FILL,FILADDR=&FILADDR,N=&N
  4502.          MEND
  4503. ./       ADD   LIST=ALL,NAME=MFCLF
  4504.          MACRO
  4505. &L       MFCLF &A,&C,&LEND,&FILL=,&FILADDR=
  4506.          AIF   ('&FILADDR' EQ '').FILL
  4507. &L       MVC   0(1,&A),&FILADDR
  4508.          AGO   .BCT
  4509. .*
  4510. .FILL    ANOP
  4511. &L       MVI   0(&A),&FILL
  4512. .BCT     BCT   &C,*+8
  4513.          B     &LEND
  4514. MFC&SYSNDX.X C &C,=F'256'
  4515.          BNH   MFC&SYSNDX.Z
  4516.          MVC   1(256,&A),0(&A)
  4517.          LA    &A,256(,&A)
  4518.          S     &C,=F'256'
  4519.          B     MFC&SYSNDX.X
  4520. MFC&SYSNDX.Y MVC 1(0,&A),0(&A)
  4521. MFC&SYSNDX.Z BCTR &C,0
  4522.          EX    &C,MFC&SYSNDX.Y
  4523.          MEND
  4524. ./       ADD   LIST=ALL,NAME=MFCLZ
  4525.          MACRO
  4526. &L       MFCLZ &A,&C
  4527.          LCLC  &LBL
  4528. &LBL     SETC  '&L'
  4529.          AIF   ('&L' NE '').LBL
  4530. &LBL     SETC  'MFC&SYSNDX.X'
  4531. .LBL     ANOP
  4532. .*
  4533. &LBL     C     &C,=F'256'
  4534.          BNH   MFC&SYSNDX.Z
  4535.          XC    0(256,&A),0(&A)
  4536.          LA    &A,256(,&A)
  4537.          S     &C,=F'256'
  4538.          B     &LBL
  4539. MFC&SYSNDX.Y XC 0(0,&A),0(&A)
  4540. MFC&SYSNDX.Z BCTR &C,0
  4541.          EX    &C,MFC&SYSNDX.Y
  4542.          MEND
  4543. ./       ADD   LIST=ALL,NAME=MI
  4544.          MACRO
  4545. &L       MI    &R,&V
  4546.          LCLA  &X,&Y,&Z
  4547. .*
  4548. .LOOP    ANOP
  4549. &X       SETA  &X+1
  4550.          AIF   (&X GT K'&V).INT
  4551.          AIF   ('&V'(&X,1) GE '0' AND '&V'(&X,1) LE '9').LOOP
  4552.     AIF ((&X EQ 1) AND (('&V'(1,1) EQ '-') OR ('&V'(1,1) EQ '+'))).LOOP
  4553. .*
  4554. &L       MH    &R,=AL2(&V)
  4555.          MEXIT
  4556. .*
  4557. .INT     ANOP
  4558.          AIF   ('&V' EQ '0').ZERO
  4559.          AIF   ('&V' EQ '1').ONE
  4560. &X       SETA  0
  4561. &Y       SETA  1
  4562. &Z       SETA  &V
  4563. .POWER   ANOP
  4564. &X       SETA  &X+1
  4565. &Y       SETA  &Y*2
  4566.          AIF   (&Y EQ &Z).SHIFT
  4567.          AIF   (&Y LT &Z AND &Y LT 16384).POWER
  4568. &L       MH    &R,=H'&V'
  4569.          MEXIT
  4570. .*
  4571. .ZERO    ANOP
  4572. &L       LA &R,0
  4573.          MEXIT
  4574. .*
  4575. .ONE     ANOP
  4576. &L       SYSLBL
  4577.          MEXIT
  4578. .*
  4579. .SHIFT   ANOP
  4580. &L       SLL   &R,&X
  4581.          MEND
  4582. ./       ADD   LIST=ALL,NAME=MMVC
  4583.          MACRO
  4584. &L       MMVC  &A,&B,&C,&N=*,&ZERO=
  4585.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  4586.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  4587. &L       SYSXXC MVC,&A,&B,&C,N=&N
  4588.          MEXIT
  4589. .*
  4590. .NULL    ANOP
  4591. &L       SYSLBL
  4592.          MEND
  4593. ./       ADD   LIST=ALL,NAME=MMVCL
  4594.          MACRO
  4595. &L       MMVCL &RA,&AA,&LA,&RB,&AB,&LB,&FILL=0,&FILADDR=,&INLINE=,&N=*
  4596.          GBLC  &CPU,&SIM370
  4597.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  4598.          AIF   ('&CPU' EQ '360').S360
  4599. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4600.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  4601.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4602.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ370
  4603.          AIF   ('&LB' EQ '(&RA+1)' OR '&LA' EQ '(&RB+1)').EQ370
  4604.          SYSLR &RB+1,&LB
  4605.          AIF   ('&FILADDR' NE '').FILADDR
  4606.          AIF   ('&FILL' EQ '' OR '&FILL' EQ '0').Z370
  4607.          O     &RB+1,=AL1(&FILL,0,0,0)
  4608.          AGO   .Z370
  4609. .*
  4610. .FILADDR ANOP
  4611.          ICM   &RB+1,8,&FILADDR
  4612. .*
  4613. .Z370    MVCL  &RA,&RB
  4614.          MEXIT
  4615. .EQ370   ANOP
  4616.          LR    &RB+1,&RA+1
  4617.          MVCL  &RA,&RB
  4618.          MEXIT
  4619. .*
  4620. .*  360 LOOP
  4621. .*
  4622. .S360    ANOP
  4623.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ360
  4624. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4625.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  4626.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4627.          SYSLR &RB+1,&LB
  4628.          SR    &RA+1,&RB+1
  4629.          BNM   *+6
  4630.          AR    &RB+1,&RA+1
  4631.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ1
  4632.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ1
  4633.          LTR   &RB+1,&RB+1
  4634.          BNP   MVC&SYSNDX.X
  4635.          MMVCLM &RA,&RB,&RB+1
  4636.          LA    &RA,1(&RA,&RB+1)
  4637. MVC&SYSNDX.X LTR &RA+1,&RA+1
  4638.          BNP   MVC&SYSNDX.Y
  4639.          MMVCLP &RA,&RA+1,FILL=&FILL,FILADDR=&FILADDR
  4640. MVC&SYSNDX.Y DS 0H
  4641.          MEXIT
  4642. .*
  4643. .RAZ1    ANOP
  4644.          XR    &RA,&RA+1
  4645.          XR    &RA+1,&RA
  4646.          XR    &RA,&RA+1
  4647.          LTR   &RB+1,&RB+1
  4648.          BNP   MVC&SYSNDX.X
  4649.          MMVCLM &RA+1,&RB,&RB+1
  4650.          LA    &RA+1,1(&RA+1,&RB+1)
  4651. MVC&SYSNDX.X LTR &RB+1,&RA
  4652.          BNP   MVC&SYSNDX.Y
  4653.          MMVCLP &RA+1,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  4654. MVC&SYSNDX.Y DS 0H
  4655.          MEXIT
  4656. .*
  4657. .RBZ1    ANOP
  4658.          XR    &RA+1,&RB
  4659.          XR    &RB,&RA+1
  4660.          XR    &RA+1,&RB
  4661.          LTR   &RB+1,&RB+1
  4662.          BNP   MVC&SYSNDX.X
  4663.          MMVCLM &RA,&RA+1,&RB+1
  4664.          LA    &RA,1(&RA,&RB+1)
  4665. MVC&SYSNDX.X LTR &RB+1,&RB
  4666.          BNP   MVC&SYSNDX.Y
  4667.          MMVCLP &RA,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  4668. MVC&SYSNDX.Y DS 0H
  4669.          MEXIT
  4670. .*
  4671. .*  360 EQUAL LENGTH
  4672. .*
  4673. .EQ360   ANOP
  4674.          AIF   ('&INLINE' EQ 'YES').INLINE
  4675.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ2
  4676.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ2
  4677. &L       SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4678.          BNP   MVC&SYSNDX.Z
  4679.          SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4680.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4681.          MMVCLM &RA,&RB,&RA+1
  4682. MVC&SYSNDX.Z DS 0H
  4683.          MEXIT
  4684. .*
  4685. .RAZ2    ANOP
  4686. &L       SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4687.          BNP   MVC&SYSNDX.Z
  4688.          SYSLR &RB+1,&AA
  4689.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4690.          MMVCLM &RB+1,&RB,&RA+1
  4691. MVC&SYSNDX.Z DS 0H
  4692.          MEXIT
  4693. .*
  4694. .RBZ2    ANOP
  4695. &L       SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4696.          BNP   MVC&SYSNDX.Z
  4697.          SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4698.          SYSLR &RB+1,&AB
  4699.          MMVCLM &RA,&RB+1,&RA+1
  4700. MVC&SYSNDX.Z DS 0H
  4701.          MEXIT
  4702. .*
  4703. .*  INLINE
  4704. .*
  4705. .INLINE  ANOP
  4706. &L       MMVC  &AA,&AB,&LA,N=&N
  4707.          MEND
  4708. ./       ADD   LIST=ALL,NAME=MMVCLM
  4709.          MACRO
  4710. &L       MMVCLM &A,&B,&C
  4711.          LCLC  &LBL
  4712. .*
  4713. &LBL     SETC  '&L'
  4714.          AIF   ('&L' NE '').OKLBL
  4715. &LBL     SETC  'MVC&SYSNDX.A'
  4716. .OKLBL   ANOP
  4717. .*
  4718. &LBL     C     &C,=F'256'
  4719.          BNH   MVC&SYSNDX.C
  4720.          MVC   0(256,&A),0(&B)
  4721.          LA    &A,256(,&A)
  4722.          LA    &B,256(,&B)
  4723.          S     &C,=F'256'
  4724.          B     &LBL
  4725. MVC&SYSNDX.B MVC 0(0,&A),0(&B)
  4726. MVC&SYSNDX.C BCTR &C,0
  4727.          EX    &C,MVC&SYSNDX.B
  4728.          MEND
  4729. ./       ADD   LIST=ALL,NAME=MMVCLP
  4730.          MACRO
  4731. &L       MMVCLP &A,&C,&FILL=0,&FILADDR=
  4732.          AIF   ('&FILADDR' EQ '').FILL
  4733. &L       MVC   0(1,&A),&FILADDR
  4734.          AGO   .BCT
  4735. .*
  4736. .FILL    ANOP
  4737.          AIF   ('&FILL' EQ '' OR '&FILL' EQ '0').ZOT
  4738. &L       MVI   0(&A),&FILL
  4739. .BCT     BCT   &C,*+8
  4740.          B     MVC&SYSNDX.G
  4741. MVC&SYSNDX.D C &C,=F'256'
  4742.          BNH   MVC&SYSNDX.F
  4743.          MVC   1(256,&A),0(&A)
  4744.          LA    &A,256(,&A)
  4745.          S     &C,=F'256'
  4746.          B     MVC&SYSNDX.D
  4747. MVC&SYSNDX.E MVC 1(0,&A),0(&A)
  4748. MVC&SYSNDX.F BCTR &C,0
  4749.          EX    &C,MVC&SYSNDX.E
  4750. MVC&SYSNDX.G DS 0H
  4751.          MEXIT
  4752. .*
  4753. .ZOT     ANOP
  4754. &L       SYSLBL
  4755. MVC&SYSNDX.D C     &C,=F'256'
  4756.          BNH   MVC&SYSNDX.F
  4757.          XC    0(256,&A),0(&A)
  4758.          LA    &A,256(,&A)
  4759.          S     &C,=F'256'
  4760.          B     MVC&SYSNDX.D
  4761. MVC&SYSNDX.E XC 0(0,&A),0(&A)
  4762. MVC&SYSNDX.F BCTR &C,0
  4763.          EX    &C,MVC&SYSNDX.E
  4764.          MEND
  4765. ./       ADD   LIST=ALL,NAME=MNC
  4766.          MACRO
  4767. &L       MNC   &A,&B,&C,&N=*,&ZERO=
  4768.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  4769.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  4770. &L       SYSXXC NC,&A,&B,&C,N=&N
  4771.          MEXIT
  4772. .*
  4773. .NULL    ANOP
  4774. &L       SYSLBL
  4775.          MEND
  4776. ./       ADD   LIST=ALL,NAME=MNCL
  4777.          MACRO
  4778. &L    MNCL  &RA,&AA,&LA,&RB,&AB,&LB,&FILL=X'FF',&FILADDR=,&INLINE=,&N=*
  4779.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  4780.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ
  4781. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4782.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  4783.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4784.          SYSLR &RB+1,&LB
  4785.          SR    &RA+1,&RB+1
  4786.          BNM   *+6
  4787.          AR    &RB+1,&RA+1
  4788.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ
  4789.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ
  4790.          LTR   &RB+1,&RB+1
  4791.          BNP   NC&SYSNDX.A
  4792.          MNCLN &RA,&RB,&RB+1
  4793.          AIF   (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''')             *
  4794.                AND '&FILADDR' EQ '').FF
  4795.          LA    &RA,1(&RA,&RB+1)
  4796.         AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').Z
  4797. NC&SYSNDX.A LTR &RA+1,&RA+1
  4798.          BNP   NC&SYSNDX.B
  4799.          MNCLF &RA,&RA+1,FILL=&FILL,FILADDR=&FILADDR
  4800. NC&SYSNDX.B DS 0H
  4801.          MEXIT
  4802. .Z       ANOP
  4803. NC&SYSNDX.A LTR &RA+1,&RA+1
  4804.          BNP   NC&SYSNDX.B
  4805.          MFCLZ &RA,&RA+1
  4806. NC&SYSNDX.B DS 0H
  4807.          MEXIT
  4808. .FF      ANOP
  4809. NC&SYSNDX.A DS 0H
  4810.          MEXIT
  4811. .*
  4812. .RAZ     ANOP
  4813.          XR    &RA,&RA+1
  4814.          XR    &RA+1,&RA
  4815.          XR    &RA,&RA+1
  4816.          LTR   &RB+1,&RB+1
  4817.          BNP   NC&SYSNDX.A
  4818.          MNCLN &RA+1,&RB,&RB+1
  4819.          AIF   (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''')             *
  4820.                AND '&FILADDR' EQ '').RAZFF
  4821.          LA    &RA+1,1(&RA+1,&RB+1)
  4822.      AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').RAZZ
  4823. NC&SYSNDX.A LTR &RB+1,&RA
  4824.          BNP   NC&SYSNDX.B
  4825.          MNCLF &RA+1,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  4826. NC&SYSNDX.B DS 0H
  4827.          MEXIT
  4828. .RAZZ    ANOP
  4829. NC&SYSNDX.A LTR &RB+1,&RA
  4830.          BNP   NC&SYSNDX.B
  4831.          MFCLZ &RA+1,&RB+1
  4832. NC&SYSNDX.B DS 0H
  4833.          MEXIT
  4834. .RAZFF   ANOP
  4835. NC&SYSNDX.A DS 0H
  4836.          MEXIT
  4837. .*
  4838. .RBZ     ANOP
  4839.          XR    &RB,&RA+1
  4840.          XR    &RA+1,&RB
  4841.          XR    &RB,&RA+1
  4842.          LTR   &RB+1,&RB+1
  4843.          BNP   NC&SYSNDX.A
  4844.          MNCLN &RA,&RA+1,&RB+1
  4845.          AIF   (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''')             *
  4846.                AND '&FILADDR' EQ '').RBZFF
  4847.          LA    &RA,1(&RA,&RB+1)
  4848.          AIF   (('&FILL' EQ '' OR '&FILL' EQ '0')                      *
  4849.                AND '&FILADDR' EQ '').RBZZ
  4850. NC&SYSNDX.A LTR &RB+1,&RB
  4851.          BNP   NC&SYSNDX.B
  4852.          MNCLF &RA,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  4853. NC&SYSNDX.B DS 0H
  4854.          MEXIT
  4855. .*
  4856. .RBZZ    ANOP
  4857. NC&SYSNDX.A LTR &RB+1,&RB
  4858.          BNP   NC&SYSNDX.B
  4859.          MFCLZ &RA,&RB+1
  4860. NC&SYSNDX.B DS 0H
  4861.          MEXIT
  4862. .RBZFF   ANOP
  4863. NC&SYSNDX.A DS 0H
  4864.          MEXIT
  4865. .*
  4866. .*   EQUAL LENGTH
  4867. .*
  4868. .EQ      ANOP
  4869.          AIF   ('&INLINE' EQ 'YES').MNC
  4870.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').EQRAZ
  4871.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').EQRBZ
  4872. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4873.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4874.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4875.          LTR   &RA+1,&RA+1
  4876.          BNP   NC&SYSNDX.A
  4877.          MNCLN &RA,&RB,&RA+1
  4878. NC&SYSNDX.A DS 0H
  4879.          MEXIT
  4880. .*
  4881. .EQRAZ   ANOP
  4882. &L       SYSLR &RB+1,&AA
  4883.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4884.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4885.          BNP   NC&SYSNDX.A
  4886.          MNCLN &RB+1,&RB,&RA+1
  4887. NC&SYSNDX.A DS 0H
  4888.          MEXIT
  4889. .*
  4890. .EQRBZ   ANOP
  4891. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4892.          SYSLR &RB+1,&AB
  4893.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4894.          BNP   NC&SYSNDX.A
  4895.          MNCLN &RA,&RB+1,&RA+1
  4896. NC&SYSNDX.A DS 0H
  4897.          MEXIT
  4898. .*
  4899. .*  MNC
  4900. .*
  4901. .MNC     ANOP
  4902. &L       MNC   &AA,&AB,&LA,N=&N
  4903.          MEND
  4904. ./       ADD   LIST=ALL,NAME=MNCLN
  4905.          MACRO
  4906. &L       MNCLN &A,&B,&C
  4907.          LCLC  &LBL
  4908. &LBL     SETC  '&L'
  4909.          AIF   ('&L' NE '').LBL
  4910. &LBL     SETC  'NC&SYSNDX.X'
  4911. .LBL     ANOP
  4912. .*
  4913. &LBL     C     &C,=F'256'
  4914.          BNH   NC&SYSNDX.Z
  4915.          NC    0(256,&A),0(&A)
  4916.          LA    &A,256(,&A)
  4917.          LA    &B,256(,&B)
  4918.          S     &C,=F'256'
  4919.          B     &LBL
  4920. NC&SYSNDX.Y NC 0(0,&A),0(&A)
  4921. NC&SYSNDX.Z BCTR &C,0
  4922.          EX    &C,NC&SYSNDX.Y
  4923.          MEND
  4924. ./       ADD   LIST=ALL,NAME=MNCLF
  4925.          MACRO
  4926. &L       MNCLF &A,&C,&FILL=,&FILADDR=
  4927.          AIF   ('&FILADDR' EQ '').FILL
  4928. &L       NC    0(1,&A),&FILADDR
  4929.          LA    &A,1(,&A)
  4930.          BCT   &C,*-10
  4931.          MEXIT
  4932. .*
  4933. .FILL    ANOP
  4934. &L       NI    0(&A),&FILL
  4935. .LA      LA    &A,1(,&A)
  4936.          BCT   &C,*-8
  4937.          MEND
  4938. ./       ADD   LIST=ALL,NAME=MOC
  4939.          MACRO
  4940. &L       MOC   &A,&B,&C,&N=*,&ZERO=
  4941. &L       SYSXXC OC,&A,&B,&C,N=&N
  4942.          MEXIT
  4943. .*
  4944. .NULL    ANOP
  4945. &L       SYSLBL
  4946.          MEND
  4947. ./       ADD   LIST=ALL,NAME=MOCL
  4948.          MACRO
  4949. &L       MOCL  &RA,&AA,&LA,&RB,&AB,&LB,&FILL=0,&FILADDR=,&INLINE=,&N=*
  4950.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  4951.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ
  4952. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4953.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  4954.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4955.          SYSLR &RB+1,&LB
  4956.          SR    &RA+1,&RB+1
  4957.          BNM   *+6
  4958.          AR    &RB+1,&RA+1
  4959.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ
  4960.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ
  4961.          LTR   &RB+1,&RB+1
  4962.          BNP   OC&SYSNDX.A
  4963.          MOCLN &RA,&RB,&RB+1
  4964.         AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').Z
  4965.          LA    &RA,1(&RA,&RB+1)
  4966.          AIF   (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''')             *
  4967.                AND '&FILADDR' EQ '').FF
  4968. OC&SYSNDX.A LTR &RA+1,&RA+1
  4969.          BNP   OC&SYSNDX.B
  4970.          MOCLF &RA,&RA+1,FILL=&FILL,FILADDR=&FILADDR
  4971. OC&SYSNDX.B DS 0H
  4972.          MEXIT
  4973. .FF      ANOP
  4974. OC&SYSNDX.A LTR &RA+1,&RA+1
  4975.          BNP   OC&SYSNDX.B
  4976.          MFCLF &RA,&RA+1,OC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
  4977. OC&SYSNDX.B DS 0H
  4978.          MEXIT
  4979. .Z       ANOP
  4980. OC&SYSNDX.A DS 0H
  4981.          MEXIT
  4982. .*
  4983. .RAZ     ANOP
  4984.          XR    &RA,&RA+1
  4985.          XR    &RA+1,&RA
  4986.          XR    &RA,&RA+1
  4987.          LTR   &RB+1,&RB+1
  4988.          BNP   OC&SYSNDX.A
  4989.          MOCLN &RA+1,&RB,&RB+1
  4990.       AIF (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').RAZZ
  4991.          LA    &RA+1,1(&RA+1,&RB+1)
  4992.          AIF   (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''')             *
  4993.                AND '&FILADDR' EQ '').RAZFF
  4994. OC&SYSNDX.A LTR &RB+1,&RA
  4995.          BNP   OC&SYSNDX.B
  4996.          MOCLF &RA+1,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  4997. OC&SYSNDX.B DS 0H
  4998.          MEXIT
  4999. .RAZFF   ANOP
  5000. OC&SYSNDX.A LTR &RB+1,&RA
  5001.          BNP   OC&SYSNDX.B
  5002.          MFCLF &RA+1,&RB+1,OC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
  5003. OC&SYSNDX.B DS 0H
  5004.          MEXIT
  5005. .RAZZ    ANOP
  5006. OC&SYSNDX.A DS 0H
  5007.          MEXIT
  5008. .*
  5009. .RBZ     ANOP
  5010.          XR    &RB,&RA+1
  5011.          XR    &RA+1,&RB
  5012.          XR    &RB,&RA+1
  5013.          LTR   &RB+1,&RB+1
  5014.          BNP   OC&SYSNDX.A
  5015.          MOCLN &RA,&RA+1,&RB+1
  5016.          AIF   (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''')             *
  5017.                AND '&FILADDR' EQ '').RBZFF
  5018.          LA    &RA,1(&RA,&RB+1)
  5019.      AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').RBZZ
  5020. OC&SYSNDX.A LTR &RB+1,&RB
  5021.          BNP   OC&SYSNDX.B
  5022.          MOCLF &RA,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  5023. OC&SYSNDX.B DS 0H
  5024.          MEXIT
  5025. .*
  5026. .RBZZ    ANOP
  5027. OC&SYSNDX.A LTR &RB+1,&RB
  5028.          BNP   OC&SYSNDX.B
  5029.          MFCLZ &RA,&RB+1
  5030. OC&SYSNDX.B DS 0H
  5031.          MEXIT
  5032. .RBZFF   ANOP
  5033. OC&SYSNDX.A DS 0H
  5034.          MEXIT
  5035. .*
  5036. .*   EQUAL LENGTH
  5037. .*
  5038. .EQ      ANOP
  5039.          AIF   ('&INLINE' EQ 'YES').MOC
  5040.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').EQRAZ
  5041.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').EQRBZ
  5042. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  5043.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  5044.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  5045.          LTR   &RA+1,&RA+1
  5046.          BNP   OC&SYSNDX.A
  5047.          MOCLN &RA,&RB,&RA+1
  5048. OC&SYSNDX.A DS 0H
  5049.          MEXIT
  5050. .*
  5051. .EQRAZ   ANOP
  5052. &L       SYSLR &RB+1,&AA
  5053.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  5054.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  5055.          BNP   OC&SYSNDX.A
  5056.          MOCLN &RB+1,&RB,&RA+1
  5057. OC&SYSNDX.A DS 0H
  5058.          MEXIT
  5059. .*
  5060. .EQRBZ   ANOP
  5061. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  5062.          SYSLR &RB+1,&AB
  5063.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  5064.          BNP   OC&SYSNDX.A
  5065.          MOCLN &RA,&RB+1,&RA+1
  5066. OC&SYSNDX.A DS 0H
  5067.          MEXIT
  5068. .*
  5069. .*  MOC
  5070. .*
  5071. .MOC     ANOP
  5072. &L       MOC   &AA,&AB,&LA,N=&N
  5073.          MEND
  5074. ./       ADD   LIST=ALL,NAME=MOCLN
  5075.          MACRO
  5076. &L       MOCLN &A,&B,&C
  5077.          LCLC  &LBL
  5078. &LBL     SETC  '&L'
  5079.          AIF   ('&L' NE '').LBL
  5080. &LBL     SETC  'OC&SYSNDX.X'
  5081. .LBL     ANOP
  5082. .*
  5083. &LBL     C     &C,=F'256'
  5084.          BNH   OC&SYSNDX.Z
  5085.          OC    0(256,&A),0(&A)
  5086.          LA    &A,256(,&A)
  5087.          LA    &B,256(,&B)
  5088.          S     &C,=F'256'
  5089.          B     &LBL
  5090. OC&SYSNDX.Y OC 0(0,&A),0(&A)
  5091. OC&SYSNDX.Z BCTR &C,0
  5092.          EX    &C,OC&SYSNDX.Y
  5093.          MEND
  5094. ./       ADD   LIST=ALL,NAME=MOCLF
  5095.          MACRO
  5096. &L       MOCLF &A,&C,&FILL=,&FILADDR=
  5097.          AIF   ('&FILADDR' EQ '').FILL
  5098. &L       OC    0(1,&A),&FILADDR
  5099.          LA    &A,1(,&A)
  5100.          BCT   &C,*-10
  5101.          MEXIT
  5102. .*
  5103. .FILL    ANOP
  5104. &L       OI    0(&A),&FILL
  5105.          LA    &A,1(,&A)
  5106.          BCT   &C,*-8
  5107.          MEND
  5108. ./       ADD   LIST=ALL,NAME=MPARMGBL
  5109. *
  5110. *  NIH/COMMON - DUMMY FOR MILTEN GLOBAL DECLARATIONS
  5111. *
  5112. ./       ADD   LIST=ALL,NAME=MPNI
  5113.          MACRO
  5114. &L       MPNI  &A,&B,&BASE=,®S=
  5115.          GBLC  &OS,&MP
  5116.          LCLC  &LBL
  5117.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NMP
  5118.          AIF   ('&MP' EQ 'NO').NMP
  5119.          AIF   ('&BASE' EQ '').NBASE
  5120.          AIF   ('&BASE'(1,1) EQ '(').BASER
  5121. .*
  5122. &L       LA    ®S(3),255-(&B)
  5123.          SLL   ®S(3),24-8*(&A-(&BASE)-(&A-(&BASE))/4*4)
  5124.          X     ®S(3),=XL4'FFFFFFFF'
  5125.          L     ®S(1),&BASE+(&A-(&BASE))/4*4
  5126.          LR    ®S(2),®S(1)
  5127.          NR    ®S(2),®S(3)
  5128.          CS    ®S(1),®S(2),&BASE+(&A-(&BASE))/4*4
  5129.          BNE   *-8
  5130.          MEXIT
  5131. .*
  5132. .BASER   ANOP
  5133. &L       LA    ®S(3),255-(&B)
  5134.          SLL   ®S(3),24-8*(&A-(&A)/4*4)
  5135.          X     ®S(3),=XL4'FFFFFFFF'
  5136.          L     ®S(1),(&A)/4*4&BASE
  5137.          LR    ®S(2),®S(1)
  5138.          NR    ®S(2),®S(3)
  5139.          CS    ®S(1),®S(2),(&A)/4*4&BASE
  5140.          BNE   *-8
  5141.          MEXIT
  5142. .*
  5143. .NBASE   ANOP
  5144. &LBL     SETC  '&L'
  5145.          AIF   ('&L' NE '').NLBL
  5146. &LBL     SETC  'MPNI&SYSNDX'
  5147. .NLBL    ANOP
  5148. &LBL     SYSLR ®S(1),&A
  5149.          LR    ®S(2),®S(1)
  5150.          N     ®S(1),=XL4'FFFFFFFC'
  5151.          SLR   ®S(2),®S(1)
  5152.          SLL   ®S(2),3
  5153.          L     ®S(3),=AL1(255-(&B),0,0,0)
  5154.          SRL   ®S(3),0(®S(2))
  5155.          X     ®S(3),=XL4'FFFFFFFF'
  5156.          L     ®S(2),0(®S(1))
  5157.          NR    ®S(3),®S(2)
  5158.          CS    ®S(2),®S(3),0(®S(1))
  5159.          BNE   &LBL
  5160.          MEXIT
  5161. .*
  5162. .NMP     ANOP
  5163.          AIF   ('&BASE' EQ '').NMPNB
  5164.          AIF   ('&BASE'(1,1) NE '(').NMPNB
  5165. &L       NI    &A&BASE,&B
  5166.          MEXIT
  5167. .*
  5168. .NMPNB   ANOP
  5169. &L       NI    &A,&B
  5170.          MEND
  5171. ./       ADD   LIST=ALL,NAME=MPOI
  5172.          MACRO
  5173. &L       MPOI  &A,&B,&BASE=,®S=
  5174.          GBLC  &OS,&MP
  5175.          LCLC  &LBL
  5176.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NMP
  5177.          AIF   ('&MP' EQ 'NO').NMP
  5178.          AIF   ('&BASE' EQ '').NBASE
  5179.          AIF   ('&BASE'(1,1) EQ '(').BASER
  5180. .*
  5181. &L       LA    ®S(3),&B
  5182.          SLL   ®S(3),24-8*(&A-(&BASE)-(&A-(&BASE))/4*4)
  5183.          L     ®S(1),&BASE+(&A-(&BASE))/4*4
  5184.          LR    ®S(2),®S(1)
  5185.          OR    ®S(2),®S(3)
  5186.          CS    ®S(1),®S(2),&BASE+(&A-(&BASE))/4*4
  5187.          BNE   *-8
  5188.          MEXIT
  5189. .*
  5190. .BASER   ANOP
  5191. &L       LA    ®S(3),&B
  5192.          SLL   ®S(3),24-8*(&A-(&A)/4*4)
  5193.          L     ®S(1),(&A)/4*4&BASE
  5194.          LR    ®S(2),®S(1)
  5195.          OR    ®S(2),®S(3)
  5196.          CS    ®S(1),®S(2),(&A)/4*4&BASE
  5197.          BNE   *-8
  5198.          MEXIT
  5199. .*
  5200. .NBASE   ANOP
  5201. &LBL     SETC  '&L'
  5202.          AIF   ('&L' NE '').NLBL
  5203. &LBL     SETC  'MPOI&SYSNDX'
  5204. .NLBL    ANOP
  5205. &LBL     SYSLR ®S(1),&A
  5206.          LR    ®S(2),®S(1)
  5207.          N     ®S(1),=XL4'FFFFFFFC'
  5208.          SLR   ®S(2),®S(1)
  5209.          SLL   ®S(2),3
  5210.          L     ®S(3),=AL1(&B,0,0,0)
  5211.          SRL   ®S(3),0(®S(2))
  5212.          L     ®S(2),0(®S(1))
  5213.          OR    ®S(3),®S(2)
  5214.          CS    ®S(2),®S(3),0(®S(1))
  5215.          BNE   &LBL
  5216.          MEXIT
  5217. .*
  5218. .NMP     ANOP
  5219.          AIF   ('&BASE' EQ '').NMPNB
  5220.          AIF   ('&BASE'(1,1) NE '(').NMPNB
  5221. &L       OI    &A&BASE,&B
  5222.          MEXIT
  5223. .*
  5224. .NMPNB   ANOP
  5225. &L       OI    &A,&B
  5226.          MEND
  5227. ./       ADD   LIST=ALL,NAME=MPXI
  5228.          MACRO
  5229. &L       MPXI  &A,&B,&BASE=,®S=
  5230.          GBLC  &OS,&MP
  5231.          LCLC  &LBL
  5232.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NMP
  5233.          AIF   ('&MP' EQ 'NO').NMP
  5234.          AIF   ('&BASE' EQ '').NBASE
  5235.          AIF   ('&BASE'(1,1) EQ '(').BASER
  5236. .*
  5237. &L       LA    ®S(3),&B
  5238.          SLL   ®S(3),24-8*(&A-(&BASE)-(&A-(&BASE))/4*4)
  5239.          L     ®S(1),&BASE+(&A-(&BASE))/4*4
  5240.          LR    ®S(2),®S(1)
  5241.          XR    ®S(2),®S(3)
  5242.          CS    ®S(1),®S(2),&BASE+(&A-(&BASE))/4*4
  5243.          BNE   *-8
  5244.          MEXIT
  5245. .*
  5246. .BASER   ANOP
  5247. &L       LA    ®S(3),&B
  5248.          SLL   ®S(3),24-8*(&A-(&A)/4*4)
  5249.          L     ®S(1),(&A)/4*4&BASE
  5250.          LR    ®S(2),®S(1)
  5251.          XR    ®S(2),®S(3)
  5252.          CS    ®S(1),®S(2),(&A)/4*4&BASE
  5253.          BNE   *-8
  5254.          MEXIT
  5255. .*
  5256. .NBASE   ANOP
  5257. &LBL     SETC  '&L'
  5258.          AIF   ('&L' NE '').NLBL
  5259. &LBL     SETC  'MPXI&SYSNDX'
  5260. .NLBL    ANOP
  5261. &LBL     SYSLR ®S(1),&A
  5262.          LR    ®S(2),®S(1)
  5263.          N     ®S(1),=XL4'FFFFFFFC'
  5264.          SLR   ®S(2),®S(1)
  5265.          SLL   ®S(2),3
  5266.          L     ®S(3),=AL1(&B,0,0,0)
  5267.          SRL   ®S(3),0(®S(2))
  5268.          L     ®S(2),0(®S(1))
  5269.          XR    ®S(3),®S(2)
  5270.          CS    ®S(2),®S(3),0(®S(1))
  5271.          BNE   &LBL
  5272.          MEXIT
  5273. .*
  5274. .NMP     ANOP
  5275.          AIF   ('&BASE' EQ '').NMPNB
  5276.          AIF   ('&BASE'(1,1) NE '(').NMPNB
  5277. &L       XI    &A&BASE,&B
  5278.          MEXIT
  5279. .*
  5280. .NMPNB   ANOP
  5281. &L       XI    &A,&B
  5282.          MEND
  5283. ./       ADD   LIST=ALL,NAME=MPZI
  5284.          MACRO
  5285. &L       MPZI  &A,&B,&BASE=,®S=
  5286.          GBLC  &OS,&MP
  5287.          LCLC  &LBL
  5288.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NMP
  5289.          AIF   ('&MP' EQ 'NO').NMP
  5290.          AIF   ('&BASE' EQ '').NBASE
  5291.          AIF   ('&BASE'(1,1) EQ '(').BASER
  5292. .*
  5293. &L       LA    ®S(3),&B
  5294.          SLL   ®S(3),24-8*(&A-(&BASE)-(&A-(&BASE))/4*4)
  5295.          X     ®S(3),=XL4'FFFFFFFF'
  5296.          L     ®S(1),&BASE+(&A-(&BASE))/4*4
  5297.          LR    ®S(2),®S(1)
  5298.          NR    ®S(2),®S(3)
  5299.          CS    ®S(1),®S(2),&BASE+(&A-(&BASE))/4*4
  5300.          BNE   *-8
  5301.          MEXIT
  5302. .*
  5303. .BASER   ANOP
  5304. &L       LA    ®S(3),&B
  5305.          SLL   ®S(3),24-8*(&A-(&A)/4*4)
  5306.          X     ®S(3),=XL4'FFFFFFFF'
  5307.          L     ®S(1),(&A)/4*4&BASE
  5308.          LR    ®S(2),®S(1)
  5309.          NR    ®S(2),®S(3)
  5310.          CS    ®S(1),®S(2),(&A)/4*4&BASE
  5311.          BNE   *-8
  5312.          MEXIT
  5313. .*
  5314. .NBASE   ANOP
  5315. &LBL     SETC  '&L'
  5316.          AIF   ('&L' NE '').NLBL
  5317. &LBL     SETC  'MPNI&SYSNDX'
  5318. .NLBL    ANOP
  5319. &LBL     SYSLR ®S(1),&A
  5320.          LR    ®S(2),®S(1)
  5321.          N     ®S(1),=XL4'FFFFFFFC'
  5322.          SLR   ®S(2),®S(1)
  5323.          SLL   ®S(2),3
  5324.          L     ®S(3),=AL1(&B,0,0,0)
  5325.          SRL   ®S(3),0(®S(2))
  5326.          X     ®S(3),=XL4'FFFFFFFF'
  5327.          L     ®S(2),0(®S(1))
  5328.          NR    ®S(3),®S(2)
  5329.          CS    ®S(2),®S(3),0(®S(1))
  5330.          BNE   &LBL
  5331.          MEXIT
  5332. .*
  5333. .NMP     ANOP
  5334.          AIF   ('&BASE' EQ '').NMPNB
  5335.          AIF   ('&BASE'(1,1) NE '(').NMPNB
  5336. &L       NI    &A&BASE,255-(&B)
  5337.          MEXIT
  5338. .*
  5339. .NMPNB   ANOP
  5340. &L       NI    &A,255-(&B)
  5341.          MEND
  5342. ./       ADD   LIST=ALL,NAME=MTC
  5343.          MACRO
  5344. &L       MTC   &A,&C,&FILL=,&FILADDR=,&N=*,&ZERO=
  5345.          LCLA  &X,&Y
  5346.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  5347.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  5348.          AIF   ('&FILL' NE '' OR '&FILADDR' NE '').CLC
  5349. &L       SYSXXC OC,&A,&A,&C,N=&N,BC=BNZ
  5350.          MEXIT
  5351. .*
  5352. .CLC     ANOP
  5353.          AIF   ('&C' NE '').NDLEN
  5354.          AIF  (T'&A NE 'M' AND T'&A NE 'N' AND T'&A NE 'O' AND         *
  5355.                T'&A NE 'T' AND T'&A NE 'U' AND T'&A NE 'W' AND         *
  5356.                T'&A NE '$').OKLEN
  5357.          MNOTE 12,'LENGTH NOT CODED AND LENGTH ATTRIBUTE NOT AVAILABLE'
  5358. &L       MTCCLI &A,&FILL,&FILADDR
  5359.          MEXIT
  5360. .*
  5361. .OKLEN   ANOP
  5362. &X       SETA  L'&A
  5363. &L       MTC   &A,&X,FILL=&FILL,FILADDR=&FILADDR,N=&N
  5364.          MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&X)'
  5365.          MEXIT
  5366. .*
  5367. .NDLEN   ANOP
  5368. &L       MTCCLI &A,&FILL,&FILADDR
  5369.          AIF   ('&N' EQ '' OR '&N' EQ '*').STAR
  5370. .ONE     BNE   MTC&SYSNDX.A
  5371.          SYSXXC CLC,&A,&A,&C-1,D1=1,N=&N,BC=(BNE,MTC&SYSNDX.B)
  5372. MTC&SYSNDX.A DS 0H
  5373.          MEXIT
  5374. .*
  5375. .STAR    ANOP
  5376.          AIF   ('&C' EQ '').ONE
  5377. .CHECK   ANOP
  5378. &Y       SETA  &Y+1
  5379.          AIF   (&Y GT K'&C).OK
  5380.          AIF   ('&C'(&Y,1) LT '0').ONE
  5381.          AGO   .CHECK
  5382. .OK      ANOP
  5383. &X       SETA  &C-1
  5384.          AIF   (&X LE 0).END
  5385.          BNE   MTC&SYSNDX.A
  5386.          AIF   (&X EQ 1).ONE2
  5387.          SYSXXC CLC,&A,&A,&X,D1=1,N=*,BC=(BNE,MTC&SYSNDX.B)
  5388. MTC&SYSNDX.A DS 0H
  5389.          MEXIT
  5390. .*
  5391. .ONE2    ANOP
  5392.          MTCCLI &A,&FILL,&FILADDR,D=1
  5393. MTC&SYSNDX.A DS 0H
  5394.          MEXIT
  5395. .*
  5396. .NULL    ANOP
  5397. &L       CLI   *+1,0
  5398. .END     MEND
  5399. ./       ADD   LIST=ALL,NAME=MTCCLI
  5400.          MACRO
  5401. &L       MTCCLI &A,&FILL,&FILADDR,&D=0
  5402.          AIF   ('&FILADDR' NE '').FILADDR
  5403.          AIF   ('&A' EQ '').NREG
  5404.          AIF   ('&A'(1,1) NE '(').NREG
  5405. &L       CLI   &D&A,&FILL
  5406.          MEXIT
  5407. .*
  5408. .NREG    ANOP
  5409.          AIF   ('&D' EQ '0').ZD
  5410. &L       CLI   &D+&A,&FILL
  5411.          MEXIT
  5412. .*
  5413. .ZD      ANOP
  5414. &L       CLI   &A,&FILL
  5415.          MEXIT
  5416. .*
  5417. .FILADDR ANOP
  5418.          AIF   ('&A' EQ '').NREGFA
  5419.          AIF   ('&A'(1,1) NE '(').NREGFA
  5420. &L       CLC   &D.(1,&A),&FILADDR
  5421.          MEXIT
  5422. .*
  5423. .NREGFA  ANOP
  5424.          AIF   ('&D' EQ '0').ZDFA
  5425. &L       MCLC  &D+&A,&FILADDR,1
  5426.          MEXIT
  5427. .*
  5428. .ZDFA    ANOP
  5429. &L       MCLC  &A,&FILADDR,1
  5430.          MEND
  5431. ./       ADD   LIST=ALL,NAME=MTCL
  5432.          MACRO
  5433. &L       MTCL  &R,&A,&C,&S,&FILL=0,&FILADDR=,&INLINE=,&N=*
  5434.          GBLC  &CPU
  5435.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  5436.          AIF   ('&CPU' EQ '360').S360
  5437. &L       SYSLR &R,&A,ERR='ADDRESS REQUIRED'
  5438.          SYSLR &R+1,&C,ERR='LENGTH REQUIRED'
  5439.          AIF   ('&FILADDR' NE '').FILADDR
  5440.          AIF   ('&FILL' EQ '' OR '&FILL' EQ '0').Z370
  5441.          L     &S+1,=AL1(&FILL,0,0,0)
  5442.          AGO   .CLCL
  5443. .*
  5444. .FILADDR ANOP
  5445.          ICM   &S+1,8,&FILADDR
  5446. .CLCL    CLCL  &R,&S
  5447.          MEXIT
  5448. .*
  5449. .Z370    ANOP
  5450.          SLR   &S+1,&S+1
  5451.          CLCL  &R,&S
  5452.          MEXIT
  5453. .*
  5454. .*  360 LOOP
  5455. .*
  5456. .S360    ANOP
  5457.          AIF   ('&INLINE' EQ 'YES').INLINE
  5458.          AIF   ('&R' EQ '0' OR '&R' EQ 'R0' OR '&R' EQ 'VR0').RZ
  5459. &L       SYSLR &R,&A,ERR='ADDRESS REQUIRED'
  5460.          SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
  5461.          BNP   MTC&SYSNDX.A
  5462.          MTCLC &R,&R+1,MTC&SYSNDX.A,FILL=&FILL,FILADDR=&FILADDR
  5463. MTC&SYSNDX.A DS 0H
  5464.          MEXIT
  5465. .*
  5466. .RZ      ANOP
  5467. &L       SYSLR &S,&A
  5468.          SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
  5469.          BNP   MTC&SYSNDX.A
  5470.          MTCLC &S,&R+1,MTC&SYSNDX.A,FILL=&FILL,FILADDR=&FILADDR
  5471. MTC&SYSNDX.A DS 0H
  5472.          MEXIT
  5473. .*
  5474. .*  INLINE
  5475. .*
  5476. .INLINE  ANOP
  5477. &L       MTC   &A,&C,FILL=&FILL,FILADDR=&FILADDR,N=&N
  5478.          MEND
  5479. ./       ADD   LIST=ALL,NAME=MTCLC
  5480.          MACRO
  5481. &L       MTCLC &A,&C,&LEND,&FILL=,&FILADDR=
  5482.          AIF   ('&FILADDR' EQ '').FILL
  5483. &L       CLC   0(1,&A),&FILADDR
  5484.          AGO   .BNE
  5485. .*
  5486. .FILL    ANOP
  5487. &L       CLI   0(&A),&FILL
  5488. .BNE     BNE   &LEND
  5489.          BCTR  &C,0
  5490.          LTR   &C,&C
  5491.          BNP   &LEND
  5492. MTC&SYSNDX.X C &C,=F'256'
  5493.          BNH   MTC&SYSNDX.Z
  5494.          CLC   1(256,&A),0(&A)
  5495.          BNE   &LEND
  5496.          LA    &A,256(,&A)
  5497.          S     &C,=F'256'
  5498.          B     MTC&SYSNDX.X
  5499. MTC&SYSNDX.Y CLC 1(0,&A),0(&A)
  5500. MTC&SYSNDX.Z BCTR &C,0
  5501.          EX    &C,MTC&SYSNDX.Y
  5502.          MEND
  5503. ./       ADD   LIST=ALL,NAME=MTR
  5504.          MACRO
  5505. &L       MTR   &A,&T,&C,&N=*,&ZERO=
  5506. &L       SYSXXC1 TR,&A,&T,&C,N=&N
  5507.          MEXIT
  5508. .*
  5509. .NULL    ANOP
  5510. &L       CLI   *+1,0
  5511.          MEND
  5512. ./       ADD   LIST=ALL,NAME=MTRL
  5513.          MACRO
  5514. &L       MTRL  &RA,&A,&T,&RC,&C,&INLINE=,&N=*
  5515.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  5516.          AIF   ('&INLINE' EQ 'YES').INLINE
  5517. &L       SYSLR &RA,&A,ERR='ADDRESS REQUIRED'
  5518.          SYSLR &RC,&C,LTR=YES,ERR='LENGTH REQUIRED'
  5519.          BNP   TR&SYSNDX.D
  5520. TR&SYSNDX.A C  &RC,=F'256'
  5521.          BNH   TR&SYSNDX.C
  5522.          MTR   0(&RA),&T,256
  5523.          LA    &RA,256(,&RA)
  5524.          S     &RC,=F'256'
  5525.          B     TR&SYSNDX.A
  5526. TR&SYSNDX.B MTR 0(&RA),&T,0
  5527. TR&SYSNDX.C BCTR &RC,0
  5528.          EX    &RC,TR&SYSNDX.B
  5529. TR&SYSNDX.D DS 0H
  5530.          MEXIT
  5531. .*
  5532. .INLINE  ANOP
  5533. &L       MTR   &A,&C,&T,N=&N
  5534.          MEND
  5535. ./       ADD   LIST=ALL,NAME=MTRT
  5536.          MACRO
  5537. &L       MTRT  &A,&T,&C,&N=*,&ZERO=
  5538.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  5539.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  5540. &L       SYSXXC1 TRT,&A,&T,&C,N=&N,BC=BNZ
  5541.          MEXIT
  5542. .*
  5543. .NULL    ANOP
  5544. &L       CLI   *+1,0
  5545.          MEND
  5546. ./       ADD   LIST=ALL,NAME=MTRTL
  5547.          MACRO
  5548. &L       MTRTL &RA,&A,&T,&RC,&C,&INLINE=,&N=*
  5549.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  5550.          AIF   ('&INLINE' EQ 'YES').INLINE
  5551. &L       SYSLR &RA,&A,ERR='ADDRESS REQUIRED'
  5552.          SYSLR &RC,&C,LTR=YES,ERR='LENGTH REQUIRED'
  5553.          BNP   TRT&SYSNDX.D
  5554. TRT&SYSNDX.A C &RC,=F'256'
  5555.          BNH   TRT&SYSNDX.C
  5556.          MTRT  0(&RA),&T,256
  5557.          BNZ   TRT&SYSNDX.D
  5558.          LA    &RA,256(,&RA)
  5559.          S     &RC,=F'256'
  5560.          B     TRT&SYSNDX.A
  5561. TRT&SYSNDX.B MTRT 0(&RA),&T,0
  5562. TRT&SYSNDX.C BCTR &RC,0
  5563.          EX    &RC,TRT&SYSNDX.B
  5564. TRT&SYSNDX.D DS 0H
  5565.          MEXIT
  5566. .*
  5567. .INLINE  ANOP
  5568. &L       MTRT  &A,&C,&T,N=&N
  5569.          MEND
  5570. ./       ADD   LIST=ALL,NAME=MXC
  5571.          MACRO
  5572. &L       MXC   &A,&B,&C,&N=*,&ZERO=
  5573.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  5574.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  5575. &L       SYSXXC XC,&A,&B,&C,N=&N
  5576.          MEXIT
  5577. .*
  5578. .NULL    ANOP
  5579. &L       SYSLBL
  5580.          MEND
  5581. ./       ADD   LIST=ALL,NAME=MXCL
  5582.          MACRO
  5583. &L       MXCL  &RA,&AA,&LA,&RB,&AB,&LB,&FILL=0,&FILADDR=,&INLINE=,&N=*
  5584.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  5585.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ
  5586. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  5587.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  5588.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  5589.          SYSLR &RB+1,&LB
  5590.          SR    &RA+1,&RB+1
  5591.          BNM   *+6
  5592.          AR    &RB+1,&RA+1
  5593.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ
  5594.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ
  5595.          LTR   &RB+1,&RB+1
  5596.          BNP   XC&SYSNDX.A
  5597.          MXCLN &RA,&RB,&RB+1
  5598.         AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').Z
  5599.          LA    &RA,1(&RA,&RB+1)
  5600. XC&SYSNDX.A LTR &RA+1,&RA+1
  5601.          BNP   XC&SYSNDX.B
  5602.          MXCLF &RA,&RA+1,FILL=&FILL,FILADDR=&FILADDR
  5603. XC&SYSNDX.B DS 0H
  5604.          MEXIT
  5605. .Z       ANOP
  5606. XC&SYSNDX.A DS 0H
  5607.          MEXIT
  5608. .*
  5609. .RAZ     ANOP
  5610.          XR    &RA,&RA+1
  5611.          XR    &RA+1,&RA
  5612.          XR    &RA,&RA+1
  5613.          LTR   &RB+1,&RB+1
  5614.          BNP   XC&SYSNDX.A
  5615.          MXCLN &RA+1,&RB,&RB+1
  5616.      AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').RAZZ
  5617.          LA    &RA+1,1(&RA+1,&RB+1)
  5618. XC&SYSNDX.A LTR &RB+1,&RA
  5619.          BNP   XC&SYSNDX.B
  5620.          MXCLF &RA+1,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  5621. XC&SYSNDX.B DS 0H
  5622.          MEXIT
  5623. .RAZZ    ANOP
  5624. XC&SYSNDX.A DS 0H
  5625.          MEXIT
  5626. .*
  5627. .RBZ     ANOP
  5628.          XR    &RB,&RA+1
  5629.          XR    &RA+1,&RB
  5630.          XR    &RB,&RA+1
  5631.          LTR   &RB+1,&RB+1
  5632.          BNP   XC&SYSNDX.A
  5633.          MXCLN &RA,&RA+1,&RB+1
  5634.          LA    &RA,1(&RA,&RB+1)
  5635.          AIF   ('&FILL' EQ '0' AND '&FILADDR' EQ '').RBZZ
  5636. XC&SYSNDX.A LTR &RB+1,&RB
  5637.          BNP   XC&SYSNDX.B
  5638.          MXCLF &RA,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  5639. XC&SYSNDX.B DS 0H
  5640.          MEXIT
  5641. .*
  5642. .RBZZ    ANOP
  5643. XC&SYSNDX.A DS 0H
  5644.          MEXIT
  5645. .*
  5646. .*   EQUAL LENGTH
  5647. .*
  5648. .EQ      ANOP
  5649.          AIF   ('&INLINE' EQ 'YES').MXC
  5650.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').EQRAZ
  5651.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').EQRBZ
  5652. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  5653.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  5654.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  5655.          LTR   &RA+1,&RA+1
  5656.          BNP   XC&SYSNDX.A
  5657.          MXCLN &RA,&RB,&RA+1
  5658. XC&SYSNDX.A DS 0H
  5659.          MEXIT
  5660. .*
  5661. .EQRAZ   ANOP
  5662. &L       SYSLR &RB+1,&AA
  5663.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  5664.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  5665.          BNP   XC&SYSNDX.A
  5666.          MXCLN &RB+1,&RB,&RA+1
  5667. XC&SYSNDX.A DS 0H
  5668.          MEXIT
  5669. .*
  5670. .EQRBZ   ANOP
  5671. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  5672.          SYSLR &RB+1,&AB
  5673.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  5674.          BNP   XC&SYSNDX.A
  5675.          MXCLN &RA,&RB+1,&RA+1
  5676. XC&SYSNDX.A DS 0H
  5677.          MEXIT
  5678. .*
  5679. .*  MXC
  5680. .*
  5681. .MXC     ANOP
  5682. &L       MXC   &AA,&AB,&LA,N=&N
  5683.          MEND
  5684. ./       ADD   LIST=ALL,NAME=MXCLN
  5685.          MACRO
  5686. &L       MXCLN &A,&B,&C
  5687.          LCLC  &LBL
  5688. &LBL     SETC  '&L'
  5689.          AIF   ('&L' NE '').LBL
  5690. &LBL     SETC  'XC&SYSNDX.X'
  5691. .LBL     ANOP
  5692. .*
  5693. &LBL     C     &C,=F'256'
  5694.          BNH   XC&SYSNDX.Z
  5695.          XC    0(256,&A),0(&A)
  5696.          LA    &A,256(,&A)
  5697.          LA    &B,256(,&B)
  5698.          S     &C,=F'256'
  5699.          B     &LBL
  5700. XC&SYSNDX.Y XC 0(0,&A),0(&A)
  5701. XC&SYSNDX.Z BCTR &C,0
  5702.          EX    &C,XC&SYSNDX.Y
  5703.          MEND
  5704. ./       ADD   LIST=ALL,NAME=MXCLF
  5705.          MACRO
  5706. &L       MXCLF &A,&C,&FILL=,&FILADDR=
  5707.          AIF   ('&FILADDR' EQ '').FILL
  5708. &L       XC    0(1,&A),&FILADDR
  5709.          LA    &A,1(,&A)
  5710.          BCT   &C,*-10
  5711.          MEXIT
  5712. .*
  5713. .FILL    ANOP
  5714. &L       XI    0(&A),&FILL
  5715.          LA    &A,1(,&A)
  5716.          BCT   &C,*-8
  5717.          MEND
  5718. ./       ADD   LIST=ALL,NAME=MZC
  5719.          MACRO
  5720. &L       MZC   &A,&C,&N=*,&ZERO=
  5721.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  5722.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  5723. &L       SYSXXC XC,&A,&A,&C,N=&N
  5724.          MEXIT
  5725. .*
  5726. .NULL    ANOP
  5727. &L       SYSLBL
  5728.          MEND
  5729. ./       ADD   LIST=ALL,NAME=MZCL
  5730.          MACRO
  5731. &L       MZCL  &R,&A,&C,&S,&INLINE=,&N=*
  5732. &L       MFCL  &R,&A,&C,&S,FILL=0,INLINE=&INLINE,N=&N
  5733.          MEND
  5734. ./       ADD   LIST=ALL,NAME=NAT
  5735.          MACRO
  5736.          NAT
  5737. *
  5738. *  NIH/COMMON - NUCLEUS ADDRESS TABLE
  5739. *
  5740. NATSTART DS    0F
  5741. NATIBMT  DC    V(IBMORG)               FIRST SVC TABLE ENTRY
  5742. NATUSERT DC    V(USERORG)              FIRST USER SVC ENTRY
  5743. NATTYPE1 DC    V(IEATYPE1)             TYPE 1 SVC SWITCH
  5744. NATSCSAV DC    V(IEASCSAV)             SVC SAVE AREA
  5745. NATINT   DC    V(IECINT)               ENTRY TO IOS FOR I/O INTERRUPT
  5746. NATDISMS DC    V(DISMISS)              RETURN POINT FROM IOS TO IO FLIH
  5747. NATIORG  DC    V(IORGSW)               I/O INTERRUPT IN IOS SWITCH
  5748. NATQIO00 DC    V(IEAQIO00)             I/O 1ST LEVEL INTERRUPT HANDLER
  5749. *
  5750.          DS    0F
  5751. NATSIZE  EQU   *-NATSTART              SIZE OF NAT
  5752.          MEND
  5753. ./       ADD   LIST=ALL,NAME=OPENP
  5754.          MACRO
  5755. &L       OPENP &DCB
  5756.          AIF   ('&DCB' EQ '').NULL
  5757.          AIF   ('&DCB'(1,1) EQ '(').REG
  5758. &L       TM    (DCBOFLGS-IHADCB)+&DCB,X'10'
  5759.          MEXIT
  5760. .*
  5761. .REG     ANOP
  5762. &L       TM    (DCBOFLGS-IHADCB)+0&DCB,X'10'
  5763.          MEXIT
  5764. .*
  5765. .NULL    ANOP
  5766. &L       SYSLBL
  5767.          MNOTE 12,'NO DCB SPECIFIED'
  5768.          MEND
  5769. ./       ADD   LIST=ALL,NAME=ORGHIGH
  5770. ALP;
  5771.  
  5772. MACRO &&L: ORGHIGH &&A,&&B,&&BASE=;
  5773.    LCLA &&X;
  5774.  
  5775.    &&L: SYSLBL;
  5776.    ORG &&A+(&&B-&&A)*((&&B+1-&&BASE)/(&&A+1-&&BASE))/((&&B+1-&&BASE)/_
  5777.        (&&A+1-&&BASE));
  5778.  
  5779.    ASM FOR &&X FROM 3 TO N'&&SYSLIST
  5780.    DO ORGHIGH *,&&SYSLIST(&&X),BASE=&&BASE;
  5781.    MEND;
  5782.  
  5783. BAL;
  5784. ./       ADD   LIST=ALL,NAME=OSCALL
  5785.          MACRO
  5786. &L       OSCALL &R,&TYPE,&VRF=,&VR0=,&VR1=,&R15=,&R0=,&R1=,&RCR=,      *
  5787.                &PARAM=,&VL=,&PARAMA=,&PARAML=,&CC=,&TEST=,&CHECK=
  5788.          GBLC  &#R15,&#R14,&#R13,&#BASER,&#R1,&#R0
  5789.          GBLC  &OS
  5790.          LCLA  &X,&Y,&Z
  5791.          LCLC  &LBL,&EP
  5792.          SYSKWT TYPE,&TYPE,(A,V),COND=NO
  5793.          SYSKWT TEST,&TEST,(YES,NO),COND=NO
  5794.          SYSKWT CC,&CC,(YES,NO),COND=NO
  5795. &LBL     SETC  '&L'
  5796. &EP      SETC  '&#R15'
  5797. .*
  5798.          AIF   ('&VRF&R15&RCR' EQ '').NVRF
  5799. &EP      SETC  '&#R14'
  5800.          AIF   ('&VRF&R15&RCR' EQ '(&#R15)').NVRF
  5801. &LBL     SYSLR &#R15,&VRF&R15&RCR
  5802. &LBL     SETC  ''
  5803. .NVRF    ANOP
  5804. .*
  5805.          AIF   ('&VR0&R0' EQ '' OR '&VR0&R0' EQ '(&#R0)').NVR0
  5806. &LBL     SYSLR &#R0,&VR0&R0
  5807. &LBL     SETC  ''
  5808. .NVR0    ANOP
  5809. .*
  5810.          AIF   ('&VR1&R1' EQ '' OR '&VR1&R1' EQ '(&#R1)').NVR1
  5811. &LBL     SYSLR &#R1,&VR1&R1
  5812. &LBL     SETC  ''
  5813. .NVR1    ANOP
  5814. .*
  5815.          AIF   ('&PARAM' EQ '').NPARAM
  5816.          AIF   ('&PARAMA' NE '').PARAMA
  5817. &X       SETA  0
  5818. &Y       SETA  0-4
  5819. .PLOOP   ANOP
  5820. &X       SETA  &X+1
  5821. &Y       SETA  &Y+4
  5822.          AIF   (&X GT N'&PARAM).PDONE
  5823. &LBL     SYSLST &Y.(,&#R13),NEW=&PARAM(&X),REG=&#R1
  5824. &LBL     SETC  ''
  5825.          AIF   ('&VL' EQ '').PLOOP
  5826.          AIF   (&X NE N'&PARAM).PLOOP
  5827.          OI    &Y.(&#R13),X'80'
  5828.          AGO   .PLOOP
  5829. .*
  5830. .PDONE   ANOP
  5831.          CPUSH &#R1,&Y
  5832.          AGO   .PCHECK
  5833. .*
  5834. .PARAMA  ANOP
  5835. &X       SETA  0
  5836. &Z       SETA  0-4
  5837. .PLOOPA  ANOP
  5838. &X       SETA  &X+1
  5839. &Z       SETA  &Z+4
  5840.          AIF   (&X GT N'&PARAM).PDONEA
  5841. &LBL     SYSLST &Z+&PARAMA,NEW=&PARAM(&X),REG=&#R1
  5842. &LBL     SETC  ''
  5843.          AIF   ('&VL' EQ '').PLOOPA
  5844.          AIF   (&X NE N'&PARAM).PLOOPA
  5845.          OI    &Z+&PARAMA,X'80'
  5846.          AGO   .PLOOPA
  5847. .*
  5848. .PDONEA  ANOP
  5849.          LA    &#R1,&PARAMA
  5850.          AIF   ('&PARAML' EQ '').PCHECK
  5851.       SYSCMP &Z,LE,&PARAML,MSG='ERROR BELOW IF PARAMETER LIST TOO LONG'
  5852. .*
  5853. .PCHECK  ANOP
  5854.          AIF   ('&VR1&R1' EQ '').NPARAM
  5855.          MNOTE 12,'BOTH &#R1 AND PARAM SPECIFIED'
  5856. .*
  5857. .NPARAM  ANOP
  5858. .*
  5859.          AIF   ('&R'(1,1) EQ '(').REG
  5860.          AIF   ('&TYPE' EQ 'A').A
  5861. &LBL     L     &EP,=V(&R)
  5862.          AGO   .BALR
  5863. .*
  5864. .A       ANOP
  5865. &LBL     L     &EP,=A(&R)
  5866.          AGO   .BALR
  5867. .*
  5868. .REG     ANOP
  5869.          AIF   ('&EP' EQ '&#R14').REG14
  5870. &LBL     SYSLR &EP,&R
  5871.          AGO   .BALR
  5872. .*
  5873. .REG14   ANOP
  5874. &EP      SETC  '&R(1)'
  5875. &LBL     SYSLBL
  5876. .*
  5877. .BALR    ANOP
  5878.          AIF   ('&TEST' NE 'YES').NTEST
  5879.          LTR   &EP,&EP
  5880.          BZ    *+6
  5881. .NTEST   ANOP
  5882.          CBALR &#R14,&EP
  5883.          AIF   (&Y LE 0).END
  5884.          AIF   ('&CC' EQ 'NO').POP
  5885.          AIF   ('&OS' EQ 'XA').IPM
  5886.          BALR  &#R14,0
  5887.          AGO   .POP
  5888. .*
  5889. .IPM     ANOP
  5890.          IPM   &#R14
  5891. .POP     ANOP
  5892.          CPOP  ,&Y
  5893.          AIF   ('&CC' EQ 'NO').END
  5894.          SPM   &#R14
  5895. .END     MEND
  5896. ./       ADD   LIST=ALL,NAME=OSENTER
  5897.          MACRO
  5898. &L       OSENTER &ENTRY=,&BASE=,&SAVE=,&PACK=,&ID=,&FORWARD=
  5899.          GBLC  &#R15,&#R14,&#R13,&#BASER,&#R1,&#R0
  5900.          LCLA  &X
  5901.          LCLC  &LBL
  5902.          LCLC  &LENSYM,&LENSYM2
  5903.          LCLA  &LENCNT
  5904. .*
  5905.          SYSKWT ENTRY,&ENTRY,(YES,NO),COND=NO
  5906.          SYSKWT BASE,&BASE,(YES,NO),COND=NO
  5907.          SYSKWT PACK,&PACK,(YES,NO),COND=NO
  5908.          SYSKWT FORWARD,&FORWARD,(YES,NO),COND=NO
  5909. .*
  5910. &LBL     SETC  '&L'
  5911. .*
  5912.          AIF   ('&ENTRY' EQ 'NO' OR '&L' EQ '').NENTRY
  5913.          AIF   ('&L'(1,1) EQ '@').NENTRY
  5914.          ENTRY &L
  5915. .NENTRY  ANOP
  5916. .*
  5917.          AIF   ('&ID' EQ '').NOID
  5918.          AIF   ('&ID' EQ '*' AND '&L&SYSECT' EQ '').NOID
  5919. &LBL     B     OSE&SYSNDX.B-*(&#R15)
  5920. &LBL     SETC  'OSE&SYSNDX.B'
  5921.          DC    AL1(L'OSE&SYSNDX.A)
  5922.          AIF   ('&ID' EQ '*').IDSTAR
  5923.          AIF   ('&ID'(1,1) EQ '''').IDSTR
  5924. OSE&SYSNDX.A DC C'&ID'
  5925.          AGO   .NOID
  5926. .*
  5927. .IDSTR   ANOP
  5928. OSE&SYSNDX.A DC C&ID
  5929.          AGO   .NOID
  5930. .*
  5931. .IDSTAR  ANOP
  5932.          AIF   ('&L' EQ '').IDCSECT
  5933. OSE&SYSNDX.A DC C'&L'
  5934.          AGO   .NOID
  5935. .*
  5936. .IDCSECT ANOP
  5937. OSE&SYSNDX.A DC C'&SYSECT'
  5938. .*
  5939. .NOID    ANOP
  5940. .*
  5941.          AIF   ('&PACK' EQ 'YES').PACK
  5942. .LOOP    ANOP
  5943. &X       SETA  &X+1
  5944.          AIF   (&X GT N'&SYSLIST).DONE
  5945.          AIF   (N'&SYSLIST(&X) GE 2).STM
  5946. &LBL ST &SYSLIST(&X),20+(&SYSLIST(&X)-16*((&SYSLIST(&X))/14))*4(,&#R13)
  5947. &LBL     SETC  ''
  5948.          AGO   .LOOP
  5949. .STM     ANOP
  5950. &LBL     STM   &SYSLIST(&X,1),&SYSLIST(&X,2),20+(&SYSLIST(&X,1)-16*((&S*
  5951.                YSLIST(&X,1))/14))*4(&#R13)
  5952. &LBL     SETC  ''
  5953.          AGO   .LOOP
  5954. .*
  5955. .PACK    ANOP
  5956. &LENSYM  SETC  '12'
  5957. .*
  5958. .PLOOP   ANOP
  5959. &X       SETA  &X+1
  5960.          AIF   (&X GT N'&SYSLIST).DONE
  5961.          AIF   (N'&SYSLIST(&X) GE 2).PSTM
  5962. &LBL     ST    &SYSLIST(&X),&LENSYM.(,&#R13)
  5963. &LBL     SETC  ''
  5964.          AIF   (&X EQ N'&SYSLIST).DONE
  5965. &LENCNT  SETA  &LENCNT+1
  5966. &LENSYM2 SETC  'OSE&SYSNDX'.'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(&LENCNT,1)
  5967. &LENSYM2 EQU   &LENSYM+4
  5968. &LENSYM  SETC  '&LENSYM2'
  5969.          AGO   .PLOOP
  5970. .*
  5971. .PSTM    ANOP
  5972. &LBL     STM   &SYSLIST(&X,1),&SYSLIST(&X,2),&LENSYM.(&#R13)
  5973. &LBL     SETC  ''
  5974.          AIF   (&X EQ N'&SYSLIST).DONE
  5975. &LENCNT  SETA  &LENCNT+1
  5976. &LENSYM2 SETC  'OSE&SYSNDX'.'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(&LENCNT,1)
  5977. &LENSYM2 EQU   &LENSYM+4*(&SYSLIST(&X,2)-&SYSLIST(&X,1)+16*((&SYSLIST(&*
  5978.                X,1)+1)/(&SYSLIST(&X,2)))/((&SYSLIST(&X,1)+1)/(&SYSLIST(*
  5979.                &X,2)))+1)
  5980. &LENSYM  SETC  '&LENSYM2'
  5981.          AGO   .PLOOP
  5982. .*
  5983. .DONE    ANOP
  5984. .*
  5985.          AIF   ('&BASE' EQ 'NO').NBASE
  5986. &LBL     CBASE &#BASER
  5987. &LBL     SETC  ''
  5988.          USING *,&#BASER
  5989. .NBASE   ANOP
  5990. .*
  5991.          AIF   ('&SAVE' EQ '').NSAVE
  5992.          AIF   ('&FORWARD' EQ 'YES').FORWARD
  5993. &LBL     ST    &#R13,&SAVE+4
  5994. &LBL     SETC  ''
  5995.          LA    &#R13,&SAVE
  5996.          AGO   .NSAVE
  5997. .*
  5998. .FORWARD ANOP
  5999. &LBL     SYSLR &#R14,&SAVE
  6000. &LBL     SETC  ''
  6001.          ST    &#R13,4(,&#R14)
  6002.          ST    &#R14,8(,&#R13)
  6003.          LR    &#R13,&#R14
  6004. .NSAVE   ANOP
  6005. .*
  6006. &LBL     SYSLBL
  6007.          MEND
  6008. ./       ADD   LIST=ALL,NAME=OSEXIT
  6009.          MACRO
  6010. &L       OSEXIT &SAVE=,<R=,&PACK=,&RC=,&FLAG=NO,&BRANCH=
  6011.          GBLC  &#R15,&#R14,&#R13,&#BASER,&#R1,&#R0
  6012.          LCLA  &X
  6013.          LCLC  &LBL
  6014.          LCLC  &LENSYM,&LENSYM2
  6015.          LCLA  &LENCNT
  6016. .*
  6017.          SYSKWT LTR,<R,(&#R0,&#R1,&#R15,R0,R1,R15),COND=NO
  6018.          SYSKWT PACK,&PACK,(YES,NO),COND=NO
  6019.          SYSKWT FLAG,&FLAG,(YES,NO),COND=NO
  6020.          SYSKWT BRANCH,&BRANCH,(YES,NO),COND=NO
  6021. .*
  6022. &LBL     SETC  '&L'
  6023. .*
  6024.          AIF   ('&SAVE' EQ '').NSAVE
  6025. &LBL     L     &#R13,4+&SAVE
  6026. &LBL     SETC  ''
  6027. .NSAVE   ANOP
  6028. .*
  6029.          AIF   ('&PACK' EQ 'YES').PACK
  6030. .LOOP    ANOP
  6031. &X       SETA  &X+1
  6032.          AIF   (&X GT N'&SYSLIST).DONE
  6033.          AIF   (N'&SYSLIST(&X) GE 2).LM
  6034. &LBL  L &SYSLIST(&X),20+(&SYSLIST(&X)-16*((&SYSLIST(&X))/14))*4(,&#R13)
  6035. &LBL     SETC  ''
  6036.          AGO   .LOOP
  6037. .LM      ANOP
  6038. &LBL     LM    &SYSLIST(&X,1),&SYSLIST(&X,2),20+(&SYSLIST(&X,1)-16*((&S*
  6039.                YSLIST(&X,1))/14))*4(&#R13)
  6040. &LBL     SETC  ''
  6041.          AGO   .LOOP
  6042. .*
  6043. .PACK    ANOP
  6044. &LENSYM  SETC  '12'
  6045. .*
  6046. .PLOOP   ANOP
  6047. &X       SETA  &X+1
  6048.          AIF   (&X GT N'&SYSLIST).DONE
  6049.          AIF   (N'&SYSLIST(&X) GE 2).PLM
  6050. &LBL     L     &SYSLIST(&X),&LENSYM.(,&#R13)
  6051. &LBL     SETC  ''
  6052.          AIF   (&X EQ N'&SYSLIST).DONE
  6053. &LENCNT  SETA  &LENCNT+1
  6054. &LENSYM2 SETC  'OSE&SYSNDX'.'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(&LENCNT,1)
  6055. &LENSYM2 EQU   &LENSYM+4
  6056. &LENSYM  SETC  '&LENSYM2'
  6057.          AGO   .PLOOP
  6058. .*
  6059. .PLM     ANOP
  6060. &LBL     LM    &SYSLIST(&X,1),&SYSLIST(&X,2),&LENSYM.(&#R13)
  6061. &LBL     SETC  ''
  6062.          AIF   (&X EQ N'&SYSLIST).DONE
  6063. &LENCNT  SETA  &LENCNT+1
  6064. &LENSYM2 SETC  'OSE&SYSNDX'.'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(&LENCNT,1)
  6065. &LENSYM2 EQU   &LENSYM+4*(&SYSLIST(&X,2)-&SYSLIST(&X,1)+16*((&SYSLIST(&*
  6066.                X,1)+1)/(&SYSLIST(&X,2)))/((&SYSLIST(&X,1)+1)/(&SYSLIST(*
  6067.                &X,2)))+1)
  6068. &LENSYM  SETC  '&LENSYM2'
  6069.          AGO   .PLOOP
  6070. .*
  6071. .DONE    ANOP
  6072. .*
  6073.          AIF   ('&FLAG' NE 'YES').NFLAG
  6074. &LBL     MVI   12(&#R13),X'FF'
  6075. &LBL     SETC  ''
  6076. .NFLAG   ANOP
  6077. .*
  6078.          AIF   ('&RC' EQ '').NRC
  6079. &LBL     SYSLR &#R15,&RC
  6080. &LBL     SETC  ''
  6081. .NRC     ANOP
  6082. .*
  6083.          AIF   ('<R' EQ '').NLTR
  6084. &LBL     LTR   <R,<R
  6085. &LBL     SETC  ''
  6086. .NLTR    ANOP
  6087. .*
  6088.          AIF   ('&BRANCH' EQ 'NO').NBRANCH
  6089. &LBL     BR    &#R14
  6090. &LBL     SETC  ''
  6091. .NBRANCH ANOP
  6092. .*
  6093. &LBL     SYSLBL
  6094.          MEND
  6095. ./       ADD   LIST=ALL,NAME=OSREGPLI
  6096.          MACRO
  6097.          OSREGPLI
  6098. *
  6099. *  REGISTER USAGE
  6100. *
  6101. *    ABSOLUTE REGISTER DEFINITIONS
  6102. *
  6103. R0       EQU   0
  6104. R1       EQU   1
  6105. R2       EQU   2
  6106. R3       EQU   3
  6107. R4       EQU   4
  6108. R5       EQU   5
  6109. R6       EQU   6
  6110. R7       EQU   7
  6111. R8       EQU   8
  6112. R9       EQU   9
  6113. R10      EQU   10
  6114. R11      EQU   11
  6115. R12      EQU   12
  6116. R13      EQU   13
  6117. R14      EQU   14
  6118. R15      EQU   15
  6119. *
  6120. *    SYMBOLIC REGISTER DEFINITIONS
  6121. *
  6122. VR0      EQU   0                       PARAMETER REGISTER
  6123. VR1      EQU   1                       PARAMETER REGISTER
  6124. XRA      EQU   2                       WORK REGISTER
  6125. XRB      EQU   3                       WORK REGISTER
  6126. XRC      EQU   4                       WORK REGISTER
  6127. XRD      EQU   5                       WORK REGISTER
  6128. XRE      EQU   6                       WORK REGISTER
  6129. XRF      EQU   7                       WORK REGISTER
  6130. XRG      EQU   8                       WORK REGISTER
  6131. XRH      EQU   9                       WORK REGISTER
  6132. XRI      EQU   10                      WORK REGISTER
  6133. BASER    EQU   11                      BASE REGISTER
  6134. GCBR     EQU   12                      GLOBAL CONTROL BLOCK REGISTER
  6135. SAVER    EQU   13                      SAVE AREA REGISTER
  6136. RTNR     EQU   14                      RETURN ADDRESS REGISTER
  6137. RCR      EQU   15                      RETURN CODE REGISTER
  6138. *
  6139. LOWR     EQU   XRA                     LOWEST REGISTER TO SAVE
  6140. HIGHR    EQU   BASER                   HIGHEST REGISTER TO SAVE
  6141.          MEND
  6142. ./       ADD   LIST=ALL,NAME=OSREGS
  6143.          MACRO
  6144.          OSREGS
  6145. *
  6146. *  REGISTER USAGE
  6147. *
  6148. *    ABSOLUTE REGISTER DEFINITIONS
  6149. *
  6150. R0       EQU   0
  6151. R1       EQU   1
  6152. R2       EQU   2
  6153. R3       EQU   3
  6154. R4       EQU   4
  6155. R5       EQU   5
  6156. R6       EQU   6
  6157. R7       EQU   7
  6158. R8       EQU   8
  6159. R9       EQU   9
  6160. R10      EQU   10
  6161. R11      EQU   11
  6162. R12      EQU   12
  6163. R13      EQU   13
  6164. R14      EQU   14
  6165. R15      EQU   15
  6166. *
  6167. *    SYMBOLIC REGISTER DEFINITIONS
  6168. *
  6169. VR0      EQU   0                       PARAMETER REGISTER
  6170. VR1      EQU   1                       PARAMETER REGISTER
  6171. XRA      EQU   2                       WORK REGISTER
  6172. XRB      EQU   3                       WORK REGISTER
  6173. XRC      EQU   4                       WORK REGISTER
  6174. XRD      EQU   5                       WORK REGISTER
  6175. XRE      EQU   6                       WORK REGISTER
  6176. XRF      EQU   7                       WORK REGISTER
  6177. XRG      EQU   8                       WORK REGISTER
  6178. XRH      EQU   9                       WORK REGISTER
  6179. XRI      EQU   10                      WORK REGISTER
  6180. XRJ      EQU   11                      WORK REGISTER
  6181. BASER    EQU   12                      BASE REGISTER
  6182. SAVER    EQU   13                      SAVE AREA REGISTER
  6183. RTNR     EQU   14                      RETURN ADDRESS REGISTER
  6184. RCR      EQU   15                      RETURN CODE REGISTER
  6185. *
  6186. LOWR     EQU   XRA                     LOWEST REGISTER TO SAVE
  6187. HIGHR    EQU   BASER                   HIGHEST REGISTER TO SAVE
  6188.          MEND
  6189. ./       ADD   LIST=ALL,NAME=OSSA
  6190.          MACRO
  6191. &L       OSSA  &PACK=,&EQU=
  6192.          GBLA  &OSSACNT
  6193.          LCLA  &X,&Y
  6194.          LCLC  &LBL,&EQUL1,&EQUL2
  6195. .*
  6196.          SYSKWT PACK,&PACK,(YES,NO),COND=NO
  6197. .*
  6198. &LBL     SETC  '&L'
  6199.          AIF   ('&LBL' NE '').LBLOK
  6200. &LBL     SETC  'OSSA&SYSNDX'
  6201. .LBLOK   ANOP
  6202. .*
  6203.          AIF   ('&PACK' EQ 'YES').PACK
  6204. &LBL     DC    18A(0)
  6205.          AIF   ('&EQU' EQ '').END
  6206. &Y       SETA  0-1
  6207. .EQU     ANOP
  6208. &Y       SETA  &Y+2
  6209.          AIF   (&Y GT N'&EQU).END
  6210. &EQU(&Y) EQU   &LBL+12+4*(&EQU(&Y+1)-14+16*((14/(&EQU(&Y+1)+1))/(14/(&E*
  6211.                QU(&Y+1)+1))))
  6212.          AGO   .EQU
  6213. .*
  6214. .PACK    ANOP
  6215. &LBL     DC    3A(0)
  6216. .*
  6217. .PACKGO  ANOP
  6218. &X       SETA  &X+1
  6219.          AIF   (&X GT N'&SYSLIST).PACKEQU
  6220.          AIF   (N'&SYSLIST(&X) EQ 1).ONE
  6221.          DC    (&SYSLIST(&X,2)+1-&SYSLIST(&X,1)+16*(((&SYSLIST(&X,1))/(*
  6222.                &SYSLIST(&X,2)+1))/((&SYSLIST(&X,1))/(&SYSLIST(&X,2)+1))*
  6223.                ))A(0)
  6224.          AGO   .PACKGO
  6225. .*
  6226. .ONE     ANOP
  6227.          DC    A(0)
  6228.          AGO   .PACKGO
  6229. .*
  6230. .PACKEQU ANOP
  6231.          AIF   ('&EQU' EQ '').END
  6232. &Y       SETA  0-1
  6233. .PEQU1   ANOP
  6234. &Y       SETA  &Y+2
  6235.          AIF   (&Y GT N'&EQU).END
  6236. &OSSACNT SETA  &OSSACNT+1
  6237. OSSA&OSSACNT.A EQU &LBL+12
  6238. &EQUL1   SETC  '0'
  6239. &EQUL2   SETC  'OSSA&OSSACNT.A'
  6240. &X       SETA  0
  6241. .PEQU2   ANOP
  6242. &X       SETA  &X+1
  6243.          AIF   (&X GT N'&SYSLIST).PDONE
  6244. &OSSACNT SETA  &OSSACNT+1
  6245.          AIF   (N'&SYSLIST(&X) LE 1).PONE
  6246. OSSA&OSSACNT.A EQU 4*(&EQU(&Y+1)-&SYSLIST(&X,1))
  6247. OSSA&OSSACNT.B EQU (((&EQU(&Y+1))/(&SYSLIST(&X,1)))/((&EQU(&Y+1))/(&SYS*
  6248.                LIST(&X,1))))*(((&SYSLIST(&X,2))/(&EQU(&Y+1)))/((&SYSLIS*
  6249.                T(&X,2))/(&EQU(&Y+1))))
  6250. OSSA&OSSACNT.C EQU 4*(&EQU(&Y+1)-(&SYSLIST(&X,1))+16)
  6251. OSSA&OSSACNT.D EQU (((&SYSLIST(&X,2))/(&EQU(&Y+1)))/((&SYSLIST(&X,2))/(*
  6252.                &EQU(&Y+1))))*(((&SYSLIST(&X,1))/(&SYSLIST(&X,2)+1))/((&*
  6253.                SYSLIST(&X,1))/(&SYSLIST(&X,2)+1)))
  6254. OSSA&OSSACNT.E EQU 4*(&EQU(&Y+1)-(&SYSLIST(&X,1)))
  6255. OSSA&OSSACNT.F EQU (((&EQU(&Y+1))/(&SYSLIST(&X,1)))/((&EQU(&Y+1))/(&SYS*
  6256.                LIST(&X,1))))*(((&SYSLIST(&X,1))/(&SYSLIST(&X,2)+1))/((&*
  6257.                SYSLIST(&X,1))/(&SYSLIST(&X,2)+1)))
  6258. OSSA&OSSACNT.G EQU 4*(&SYSLIST(&X,2)+1-(&SYSLIST(&X,1))+16*(((&SYSLIST(*
  6259.                &X,1))/(&SYSLIST(&X,2)+1))/((&SYSLIST(&X,1))/(&SYSLIST(&*
  6260.                X,2)+1))))
  6261. OSSA&OSSACNT.H EQU &EQUL1+OSSA&OSSACNT.B+OSSA&OSSACNT.D+OSSA&OSSACNT.F
  6262. OSSA&OSSACNT.I EQU &EQUL2+(OSSA&OSSACNT.A*OSSA&OSSACNT.B+OSSA&OSSACNT.C*
  6263.                *OSSA&OSSACNT.D+OSSA&OSSACNT.E*OSSA&OSSACNT.F)*(1-&EQUL1*
  6264.                )+OSSA&OSSACNT.G*(1-OSSA&OSSACNT.H)
  6265. &EQUL1   SETC  'OSSA&OSSACNT.H'
  6266. &EQUL2   SETC  'OSSA&OSSACNT.I'
  6267.          AGO   .PEQU2
  6268. .*
  6269. .PONE    ANOP
  6270. OSSA&OSSACNT.A EQU (((&EQU(&Y+1))/(&SYSLIST(&X,1)))/((&EQU(&Y+1))/(&SYS*
  6271.                LIST(&X,1))))*(((&SYSLIST(&X,1))/(&EQU(&Y+1)))/((&SYSLIS*
  6272.                T(&X,1))/(&EQU(&Y+1))))
  6273. OSSA&OSSACNT.B EQU &EQUL1+OSSA&OSSACNT.A*(1-&EQUL1)
  6274. OSSA&OSSACNT.C EQU &EQUL2+4*(1-OSSA&OSSACNT.B)
  6275. &EQUL1   SETC  'OSSA&OSSACNT.B'
  6276. &EQUL2   SETC  'OSSA&OSSACNT.C'
  6277.          AGO   .PEQU2
  6278. .*
  6279. .PDONE   ANOP
  6280.         SYSCMP &EQUL1,EQ,1,MSG='ERROR BELOW IF &EQU(&Y+1) OUT OF RANGE'
  6281. &EQU(&Y) EQU   &EQUL2
  6282.          AGO   .PEQU1
  6283. .END     MEND
  6284. ./       ADD   LIST=ALL,NAME=OSSETUP
  6285.          MACRO
  6286. &L       OSSETUP ®S=YES,&CBS=YES,                                   *
  6287.                &MDC=NO,&CVT=NO,&DCB=NO,&DEB=NO,&UCB=NO,&DECB=NO,       *
  6288.                &NAT=NO,&SCT=NO,&TCB=NO,&CDE=NO,&PQE=NO,&RB=NO,         *
  6289.                &ASCB=NO,&S99=NO,&ACB=NO,&RPL=NO,&LRC=NO,&SSOB=NO,      *
  6290.                &SDWA=NO,&JESCT=NO,&PSA=NO,&PCCA=NO,&TQE=NO,&LLE=NO,    *
  6291.                &ASXB=NO,                                               *
  6292.                &R15=RCR,&R14=RTNR,&R13=SAVER,&BASER=BASER,             *
  6293.                &R1=VR1,&R0=VR0
  6294. .*
  6295. &L       CSETUP REGS=NO,SCABBRS=NO,CBS=&CBS,                           *
  6296.                MDC=&MDC,CVT=&CVT,DCB=&DCB,DEB=&DEB,UCB=&UCB,DECB=&DECB,*
  6297.                NAT=&NAT,SCT=&SCT,TCB=&TCB,CDE=&CDE,PQE=&PQE,RB=&RB,    *
  6298.                ASCB=&ASCB,S99=&S99,ACB=&ACB,RPL=&RPL,LRC=&LRC,         *
  6299.                SSOB=&SSOB,SDWA=&SDWA,JESCT=&JESCT,PSA=&PSA,PCCA=&PCCA, *
  6300.                TQE=&TQE,LLE=&LLE,ASXB=&ASXB,                           *
  6301.                R15=&R15,R14=&R14,R13=&R13,BASER=&BASER,R1=&R1,R0=&R0
  6302. .*
  6303.          AIF   ('®S' EQ 'NO').NREGS
  6304.          AIF   ('®S' EQ 'PLI').PLIREGS
  6305.          OSREGS
  6306.          AGO   .NREGS
  6307. .*
  6308. .PLIREGS ANOP
  6309.          OSREGPLI
  6310. .NREGS   ANOP
  6311.          MEND
  6312. ./       ADD   LIST=ALL,NAME=RM
  6313.          MACRO
  6314. &L       RM    &R
  6315. &L       LTR   &R,&R
  6316.          MEND
  6317. ./       ADD   LIST=ALL,NAME=RMP
  6318.          MACRO
  6319. &L       RMP   &R
  6320. &L       LTR   &R,&R
  6321.          MEND
  6322. ./       ADD   LIST=ALL,NAME=RMZ
  6323.          MACRO
  6324. &L       RMZ   &R
  6325. &L       LTR   &R,&R
  6326.          MEND
  6327. ./       ADD   LIST=ALL,NAME=RNM
  6328.          MACRO
  6329. &L       RNM   &R
  6330. &L       LTR   &R,&R
  6331.          MEND
  6332. ./       ADD   LIST=ALL,NAME=RNMP
  6333.          MACRO
  6334. &L       RNMP  &R
  6335. &L       LTR   &R,&R
  6336.          MEND
  6337. ./       ADD   LIST=ALL,NAME=RNMZ
  6338.          MACRO
  6339. &L       RNMZ  &R
  6340. &L       LTR   &R,&R
  6341.          MEND
  6342. ./       ADD   LIST=ALL,NAME=RNP
  6343.          MACRO
  6344. &L       RNP   &R
  6345. &L       LTR   &R,&R
  6346.          MEND
  6347. ./       ADD   LIST=ALL,NAME=RNZ
  6348.          MACRO
  6349. &L       RNZ   &R
  6350. &L       LTR   &R,&R
  6351.          MEND
  6352. ./       ADD   LIST=ALL,NAME=RNZP
  6353.          MACRO
  6354. &L       RNZP  &R
  6355. &L       LTR   &R,&R
  6356.          MEND
  6357. ./       ADD   LIST=ALL,NAME=RP
  6358.          MACRO
  6359. &L       RP    &R
  6360. &L       LTR   &R,&R
  6361.          MEND
  6362. ./       ADD   LIST=ALL,NAME=RZ
  6363.          MACRO
  6364. &L       RZ    &R
  6365. &L       LTR   &R,&R
  6366.          MEND
  6367. ./       ADD   LIST=ALL,NAME=RZP
  6368.          MACRO
  6369. &L       RZP   &R
  6370. &L       LTR   &R,&R
  6371.          MEND
  6372. ./       ADD   LIST=ALL,NAME=SCABBR
  6373.          MACRO
  6374.          SCABBR &W
  6375.          GBLC  &SCABWRD(400),&SCABWDF(400),&SCABABR(500),&SCABABF(500)
  6376.          GBLA  &SCABP(400),&SCABC(400),&SCABN,&SCABAN
  6377.          GBLB  &SCABAC(500)
  6378.          LCLA  &X
  6379.          LCLC  &A,&B
  6380. .*
  6381.          AIF   ('&W' EQ '').END
  6382. .*
  6383.          AIF   (&SCABN LT 400).ROOM
  6384.          MNOTE 12,'SCABBR WORD TABLE IS FULL'
  6385.          MEXIT
  6386. .*
  6387. .ROOM    ANOP
  6388.          AIF   ('&W'(1,1) EQ '''').Q
  6389. .*
  6390.          AIF   (&SCABN LE 0).NTEST
  6391. &A       SETC  '''&W''                '(1,16)
  6392.          AIF   (K'&W LE 14).OK
  6393. &A       SETC  '&A'(1,15).''''
  6394. .OK      ANOP
  6395. &B       SETC  '&SCABWRD(&SCABN)                '(1,16)
  6396.          AIF   ('&A' GT '&B').NTEST
  6397.          MNOTE 12,'WORD BELOW IS OUT OF ORDER'
  6398.          MNOTE 12,'&W'
  6399.          MEXIT
  6400. .*
  6401. .NTEST   ANOP
  6402.          AIF   (N'&SYSLIST LE 1).END
  6403. &SCABN   SETA  &SCABN+1
  6404. &SCABWDF(&SCABN) SETC '''&W'''
  6405. &SCABWRD(&SCABN) SETC '''&W'''
  6406.          AIF   (K'&W LE 14).APUT
  6407. &SCABWRD(&SCABN) SETC '&SCABWRD(&SCABN)'(1,15).''''
  6408.          AGO   .APUT
  6409. .*
  6410. .Q       ANOP
  6411.          AIF   (&SCABN LE 0).NTESTQ
  6412. &A       SETC  '&W                '(1,16)
  6413.          AIF   (K'&W LE 16).OKQ
  6414. &A       SETC  '&A'(1,15).''''
  6415. .OKQ     ANOP
  6416. &B    SETC  '&SCABWRD(&SCABN)                '(1,16)
  6417.          AIF   ('&A' GT '&B').NTEST
  6418.          MNOTE 12,'WORD BELOW IS OUT OF ORDER'
  6419.          MNOTE 12,&W
  6420.          MEXIT
  6421. .*
  6422. .NTESTQ  ANOP
  6423.          AIF   (N'&SYSLIST LE 1).END
  6424. &SCABN   SETA  &SCABN+1
  6425. &SCABWDF(&SCABN) SETC '&W'
  6426. &SCABWRD(&SCABN) SETC '&W'
  6427.          AIF   (K'&W LE 16).APUT
  6428. &SCABWRD(&SCABN) SETC '&SCABWRD(&SCABN)'(1,15).''''
  6429. .*
  6430. .APUT    ANOP
  6431. &SCABP(&SCABN) SETA &SCABAN+1
  6432. &X       SETA  1
  6433. .*
  6434. .ALOOP   ANOP
  6435. &X       SETA  &X+1
  6436.          AIF   (&X GT N'&SYSLIST).ADONE
  6437.          AIF   ('&SYSLIST(&X,1)' EQ '').ALOOP
  6438.          AIF   (&SCABAN LT 500).AOK
  6439.          MNOTE 12,'SCABBR SYNONYM TABLE IS FULL'
  6440.          MEXIT
  6441. .*
  6442. .AOK     ANOP
  6443. &SCABAN  SETA  &SCABAN+1
  6444. &SCABC(&SCABN) SETA &SCABC(&SCABN)+1
  6445. &SCABAC(&SCABAN) SETB ('&SYSLIST(&X)' NE '&SYSLIST(&X,1)')
  6446.          AIF   ('&SYSLIST(&X,1)'(1,1) EQ '''').AQ
  6447. &SCABABF(&SCABAN) SETC '''&SYSLIST(&X,1)'''
  6448. &SCABABR(&SCABAN) SETC '''&SYSLIST(&X,1)'''
  6449.          AIF   (K'&SYSLIST(&X,1) LE 14).ALOOP
  6450. &SCABABR(&SCABAN) SETC '&SCABABR(&SCABAN)'(1,15).''''
  6451.          AGO   .ALOOP
  6452. .*
  6453. .AQ      ANOP
  6454. &SCABABF(&SCABAN) SETC '&SYSLIST(&X,1)'
  6455. &SCABABR(&SCABAN) SETC '&SYSLIST(&X,1)'
  6456.          AIF   (K'&SYSLIST(&X,1) LE 16).ALOOP
  6457. &SCABABR(&SCABAN) SETC '&SCABABR(&SCABAN)'(1,15).''''
  6458.          AGO   .ALOOP
  6459. .*
  6460. .ADONE   ANOP
  6461. .*
  6462. .END     MEND
  6463. ./       ADD   LIST=ALL,NAME=SCABBRS
  6464.          MACRO
  6465.          SCABBRS
  6466.          SCABBR ABBREVIATION,ABB,ABBR,ABBREV
  6467.          SCABBR ABBREVIATIONS,ABBS,ABBRS,ABBREVS
  6468.          SCABBR ACCOUNT,ACC,ACCT
  6469.          SCABBR ACCOUNTC,ACCC,ACCTC
  6470.          SCABBR ACCOUNTS,ACCS,ACCTS
  6471.          SCABBR ACTIVE,ACT
  6472.          SCABBR ACTIVES,ACTS
  6473.          SCABBR ADDRESS,ADDR
  6474.          SCABBR ADJUST,ADJ
  6475.          SCABBR AFTER,AFT
  6476.          SCABBR ALIGN,ALI
  6477.          SCABBR ALTER,ALT,(A)
  6478.          SCABBR ALWAYS,ALW
  6479.          SCABBR AND,'&&'
  6480.          SCABBR APPARENT,APP
  6481.          SCABBR ARGUMENT,ARG
  6482.          SCABBR ATTENTION,ATTN
  6483.          SCABBR AUTOMATIC,AUTO
  6484.          SCABBR BACKLOG,BKL
  6485.          SCABBR BACKSLASH,BKSL
  6486.          SCABBR BACKSPACE,BKSP,BS
  6487.          SCABBR BACKWARD,BKWD,BKW,(B)
  6488.          SCABBR BACKWARDS,BKWDS,BKWS
  6489.          SCABBR BATCH,BAT
  6490.          SCABBR BEFORE,BEF
  6491.          SCABBR BETWEEN,BET
  6492.          SCABBR BLANK,BL
  6493.          SCABBR BLANKS,BLS
  6494.          SCABBR BLOCK,BLK
  6495.          SCABBR BLOCKS,BLKS
  6496.          SCABBR BOOLEAN,BOOL
  6497.          SCABBR BOX,B
  6498.          SCABBR BURST,BUR
  6499.          SCABBR CANCEL,CAN
  6500.          SCABBR CARRIAGERETURN,CR
  6501.          SCABBR CATALOG,CAT,CATLG,CTLG
  6502.          SCABBR CEILING,CEIL
  6503.          SCABBR CENTER,CEN
  6504.          SCABBR CENTRAL,CEN,LOCAL
  6505.          SCABBR CENTSIGN,CENT
  6506.          SCABBR CHANGE,CH
  6507.          SCABBR CHARACTER,CHAR
  6508.          SCABBR CHARACTERS,CHARS
  6509.          SCABBR CHECK,CHK
  6510.          SCABBR CHECKPOINT,CKPT
  6511.          SCABBR CIRCUMFLEX,CFX
  6512.          SCABBR CLASS,CLS
  6513.          SCABBR CLEAN,CLN
  6514.          SCABBR CLEAR,CLR
  6515.          SCABBR COLLECT,COL,(C)
  6516.          SCABBR COLUMN,COL
  6517.          SCABBR COLUMNA,COLA
  6518.          SCABBR COLUMNS,COLS
  6519.          SCABBR COLUMNSA,COLSA
  6520.          SCABBR COMMAND,CMD
  6521.          SCABBR COMMANDS,CMDS
  6522.          SCABBR COMMON,COM
  6523.          SCABBR COMMONS,COMS
  6524.          SCABBR COMPARE,COMP
  6525.          SCABBR CONDENSE,COND
  6526.          SCABBR CONSOLE,CON
  6527.          SCABBR CONSTANT,CONST
  6528.          SCABBR CONTENT,CONT
  6529.          SCABBR CONTENTS,CONTS
  6530.          SCABBR CONTINUE,CONT
  6531.          SCABBR CONTROL,CTL,CNTL
  6532.          SCABBR COPIES,COPS,COPYS,CPYS
  6533.          SCABBR COPY,COP,CPY
  6534.          SCABBR COUNT,CNT
  6535.          SCABBR COUNTERS,CTRS
  6536.          SCABBR COUNTS,CNTS
  6537.          SCABBR CREATE,CRE
  6538.          SCABBR CURRENT,CUR,C
  6539.          SCABBR CYCLE,CYC
  6540.          SCABBR CYLINDER,CYL
  6541.          SCABBR CYLINDERS,CYLS
  6542.          SCABBR DATED,DTD
  6543.          SCABBR DDNAME,DDN,DD
  6544.          SCABBR DDNAMES,DDNS,DDS
  6545.          SCABBR DEFAULT,DEF
  6546.          SCABBR DELETE,DEL,(D)
  6547.          SCABBR DELIMITER,DLM
  6548.          SCABBR DENSITY,DEN
  6549.          SCABBR DEVICE,DEV
  6550.          SCABBR DIGIT,DIG
  6551.          SCABBR DIRECTORY,DIR
  6552.          SCABBR DISCOUNT,DISC,DIS
  6553.          SCABBR DITTO,DIT
  6554.          SCABBR DOUBLE,DBL
  6555.          SCABBR DOWN,DN
  6556.          SCABBR DSNAME,DSN
  6557.          SCABBR DSNAMES,DSNS
  6558.          SCABBR DUPLICATE,DUP
  6559.          SCABBR DUPLICATES,DUPS,DUP
  6560.          SCABBR EBCDIC,EBC
  6561.          SCABBR EMPTY,EMP
  6562.          SCABBR ENCLOSE,ENC
  6563.          SCABBR END,E
  6564.          SCABBR ENDBLINK,EBK
  6565.          SCABBR ENDBOLD,EBD
  6566.          SCABBR ENDFIELD,EFD
  6567.          SCABBR ENDREVERSE,ERV
  6568.          SCABBR ENDUNDERLINE,EUL
  6569.          SCABBR ENTER,ENT
  6570.          SCABBR ERROR,ERR
  6571.          SCABBR ERRORS,ERRS
  6572.          SCABBR ESCAPE,ESC
  6573.          SCABBR EVERY,EV
  6574.          SCABBR EXCHANGE,EXCH
  6575.          SCABBR EXCLUSIVE,EXC
  6576.          SCABBR EXECUTE,EX,EXEC,XEQ,(X)
  6577.          SCABBR EXPLAIN,EXPL
  6578.          SCABBR FETCH,FET
  6579.          SCABBR FIRST,F
  6580.          SCABBR FLAG,FLG
  6581.          SCABBR FLAGGED,FLGD
  6582.          SCABBR FOLLOWING,FOL
  6583.          SCABBR FOOTING,FOOT
  6584.          SCABBR FORGET,FGT
  6585.          SCABBR FORGOTTEN,FGTN
  6586.          SCABBR FORMAT,FMT
  6587.          SCABBR FORMFEED,FF
  6588.          SCABBR FORMLETTER,FORMLTR,FORML
  6589.          SCABBR FORWARD,FWD,(F)
  6590.          SCABBR FORWARDS,FWDS
  6591.          SCABBR FROM,FR
  6592.          SCABBR GLOBAL,GBL
  6593.          SCABBR GLOBALS,GBLS
  6594.          SCABBR GROUP,GRP
  6595.          SCABBR HALFLINEFEED,HLF
  6596.          SCABBR HEADING,HEAD
  6597.          SCABBR HEIGHT,HGT
  6598.          SCABBR HORIZONTALTAB,HT
  6599.          SCABBR HYPHENATE,HYP,HY
  6600.          SCABBR INCREMENT,INCR
  6601.          SCABBR INDENT,IND
  6602.          SCABBR INFINITY,INF
  6603.          SCABBR INITIAL,INIT
  6604.          SCABBR INITIALS,INIT,INITS
  6605.          SCABBR INITIALSC,INITC,INITSC
  6606.          SCABBR INSERT,INS,(I)
  6607.          SCABBR INTEGER,INT
  6608.          SCABBR ISBOOLEAN,ISBOOL
  6609.          SCABBR ISINTEGER,ISINT
  6610.          SCABBR ISNUMBER,ISNUM
  6611.          SCABBR JOBNUMBER,JOBNUM
  6612.          SCABBR JOIN,(J)
  6613.          SCABBR JUSTIFIED,JUS,JUST
  6614.          SCABBR JUSTIFY,JUS,JUST
  6615.          SCABBR KEYWORD,KEY,KW
  6616.          SCABBR KEYWORDS,KEYS,KWS
  6617.          SCABBR LABEL,LAB,LBL
  6618.          SCABBR LAST,L
  6619.          SCABBR LEFTCURLY,LCURL
  6620.          SCABBR LEFTSQUARE,LSQ
  6621.          SCABBR LENGTH,LEN
  6622.          SCABBR LENGTHA,LENA
  6623.          SCABBR LETTER,LTR
  6624.          SCABBR LEVEL,LEV
  6625.          SCABBR LIMIT,LIM
  6626.          SCABBR LINEFEED,LF
  6627.          SCABBR LIST,LIS,(L)
  6628.          SCABBR LOCAL,LOC,LCL
  6629.          SCABBR LOCALS,LOCS,LCLS
  6630.          SCABBR LOCATE,LOC
  6631.          SCABBR LOGOFF,LOGOUT
  6632.          SCABBR LOGON,LOGIN
  6633.          SCABBR LOWER,LOW
  6634.          SCABBR MARKER,MAR,MARK
  6635.          SCABBR MASTER,MAS,MAST
  6636.          SCABBR MAXIMUM,MAX
  6637.          SCABBR MEMBER,MEM
  6638.          SCABBR MEMBERS,MEMS
  6639.          SCABBR MESSAGE,MSG
  6640.          SCABBR MESSAGES,MSGS
  6641.          SCABBR MILTEN,MIL
  6642.          SCABBR MINIMUM,MIN
  6643.          SCABBR MODIFY,MOD,(M)
  6644.          SCABBR MONITOR,MON
  6645.          SCABBR MULTICOLUMN,MULTICOL
  6646.          SCABBR MULTICOLUMNS,MULTICOLS
  6647.          SCABBR MULTIPLE,MUL,MULT
  6648.          SCABBR NEQ,NE
  6649.          SCABBR NEWFONT,NF
  6650.          SCABBR NEWLINE,NL
  6651.          SCABBR NO,N
  6652.          SCABBR NOACCOUNT,NOACC,NOACCT
  6653.          SCABBR NOACCOUNTS,NOACCS,NOACCTS
  6654.          SCABBR NOADJUST,NOADJ
  6655.          SCABBR NOATTENTION,NOATTN
  6656.          SCABBR NOBOX,NOB
  6657.          SCABBR NOCLEAN,NOCLN
  6658.          SCABBR NOCOLUMN,NOCOL
  6659.          SCABBR NOCOLUMNS,NOCOLS
  6660.          SCABBR NOCONTINUE,NOCONT
  6661.          SCABBR NOCOPIES,NOCOPS,NOCOPYS,NOCPYS
  6662.          SCABBR NOCOPY,NOCOP,NOCPY
  6663.          SCABBR NOCREATE,NOCRE
  6664.          SCABBR NODEFAULT,NODEF
  6665.          SCABBR NODISCOUNT,NODISC,NODIS
  6666.          SCABBR NODOWN,NODN
  6667.          SCABBR NODSNAME,NODSN
  6668.          SCABBR NOESCAPE,NOESC
  6669.          SCABBR NOEXCLUSIVE,NOEXC
  6670.          SCABBR NOEXECUTE,NOEXEC,NOEX,NOXEQ
  6671.          SCABBR NOFLAG,NOFLG
  6672.          SCABBR NOFORMFEED,NOFF
  6673.          SCABBR NOHEIGHT,NOHGT
  6674.          SCABBR NOHYPHENATE,NOHYP,NOHY
  6675.          SCABBR NOINDENT,NOIND
  6676.          SCABBR NOINITIALS,NOINITS,NOINIT
  6677.          SCABBR NOJOBNUMBER,NOJOBNUM
  6678.          SCABBR NOJUSTIFY,NOJUS,NOJUST
  6679.          SCABBR NOKEYWORD,NOKEY,NOKW
  6680.          SCABBR NOKEYWORDS,NOKEYS,NOKWS
  6681.          SCABBR NOLABEL,NOLAB,NOLBL
  6682.          SCABBR NOLENGTH,NOLEN
  6683.          SCABBR NOLIMIT,NOLIM
  6684.          SCABBR NOLIST,NOL
  6685.          SCABBR NOMARKER,NOMAR,NOMARK
  6686.          SCABBR NOMESSAGE,NOMSG
  6687.          SCABBR NOMESSAGES,NOMSGS
  6688.          SCABBR NOMULTICOLUMN,NOMULTICOL
  6689.          SCABBR NOMULTICOLUMNS,NOMULTICOLS
  6690.          SCABBR NONOTIFY,NONTF
  6691.          SCABBR NONSTANDARD,NONSTD,NSTD
  6692.          SCABBR NONUMBER,NONUM
  6693.          SCABBR NOOPERATOR,NOOPER,NOOPR
  6694.          SCABBR NOOVERLAP,NOOVLAP
  6695.          SCABBR NOOVERLAY,NOOVLAY
  6696.          SCABBR NOPOINT,NOPNT,NOPT
  6697.          SCABBR NOPREFIX,NOPRE
  6698.          SCABBR NOPREVIEW,NOPV
  6699.          SCABBR NOPRIORITY,NOPRIO,NOPRI
  6700.          SCABBR NOPRIVILEGE,NOPRIV
  6701.          SCABBR NOPROGRAMMER,NOPGMR
  6702.          SCABBR NOPURGE,NOPUR
  6703.          SCABBR NOQUICK,NOQCK
  6704.          SCABBR NORECOVERY,NORECOV
  6705.          SCABBR NORETRY,NORT
  6706.          SCABBR NORETURN,NORTN
  6707.          SCABBR NOROUTE,NORTE
  6708.          SCABBR NOSCRATCH,NOSCR
  6709.          SCABBR NOSECOND,NOSEC
  6710.          SCABBR NOSECONDS,NOSECS
  6711.          SCABBR NOSPACE,NOSP
  6712.          SCABBR NOSTATEMENT,NOSTMT
  6713.          SCABBR NOSTATEMENTS,NOSTMTS
  6714.          SCABBR NOSUBTITLE,NOSUBTTL
  6715.          SCABBR NOT,^
  6716.          SCABBR NOTEMPORARY,NOTEMP
  6717.          SCABBR NOTERSE,NOTER
  6718.          SCABBR NOTEXT,NOTXT,NOTX
  6719.          SCABBR NOTIFY,NTF
  6720.          SCABBR NOTIMEOUT,NOTIME
  6721.          SCABBR NOTITLE,NOTTL
  6722.          SCABBR NOVERIFY,NOVER
  6723.          SCABBR NOVOLUME,NOVOL
  6724.          SCABBR NOWIDTH,NOWID
  6725.          SCABBR NUMBER,NUM
  6726.          SCABBR NUMBERED,NUMD
  6727.          SCABBR OCCURRENCES,OCCURS,OCCUR,OCCS,OCC
  6728.          SCABBR OFFLINE,OFF
  6729.          SCABBR OPERATOR,OPER,OPR
  6730.          SCABBR OR,|
  6731.          SCABBR OUTPUT,OUT
  6732.          SCABBR OVERLAP,OVLAP
  6733.          SCABBR OVERLAY,OVLAY
  6734.          SCABBR PAGE,PG
  6735.          SCABBR PAGINATE,PAG
  6736.          SCABBR PARAGRAPH,PAR,PGH
  6737.          SCABBR PATTERN,PAT
  6738.          SCABBR POINT,PNT,PT,(P)
  6739.          SCABBR POSITION,POS
  6740.          SCABBR POSITIONAL,POS
  6741.          SCABBR PRECEDING,PREC
  6742.          SCABBR PREFIX,PRE
  6743.          SCABBR PREVIEW,PV
  6744.          SCABBR PREVIOUS,PREV,PRV
  6745.          SCABBR PRINT,PRT,PRNT
  6746.          SCABBR PRIORITY,PRI,PRIO
  6747.          SCABBR PRIVILEGE,PRIV
  6748.          SCABBR PROCEDURE,PROC
  6749.          SCABBR PROCEDURES,PROCS
  6750.          SCABBR PROGRAM,PROG,PGM
  6751.          SCABBR PROGRAMMER,PGMR
  6752.          SCABBR PUNCH,PUN
  6753.          SCABBR PUNCTUATION,PUNC
  6754.          SCABBR PURGE,PUR
  6755.          SCABBR QUICK,QCK
  6756.          SCABBR QUIET,QUI
  6757.          SCABBR RECATALOG,RECAT,RECTLG,RECATLG
  6758.          SCABBR RECEIVE,RCV
  6759.          SCABBR RECOVERY,RECOV
  6760.          SCABBR RELEASE,RLSE,RLS
  6761.          SCABBR REMEMBER,REMEM
  6762.          SCABBR REMOTE,REM,RMT
  6763.          SCABBR RENAME,REN
  6764.          SCABBR RENUMBER,RENUM
  6765.          SCABBR REPLACE,REP,(R)
  6766.          SCABBR RESAVE,RSV
  6767.          SCABBR RETRIEVE,RTV,RETRV
  6768.          SCABBR RETRY,RT
  6769.          SCABBR RETURN,RTN
  6770.          SCABBR RETURNS,RTNS
  6771.          SCABBR REVERSEHALFLINEFEED,RHLF
  6772.          SCABBR REVERSELINEFEED,RLF
  6773.          SCABBR REVERSESLASH,RSLASH
  6774.          SCABBR RIGHTCURLY,RCURL
  6775.          SCABBR RIGHTSQUARE,RSQ
  6776.          SCABBR ROUTE,RTE
  6777.          SCABBR SAVE,SV
  6778.          SCABBR SCRATCH,SCR
  6779.          SCABBR SECOND,SEC
  6780.          SCABBR SECONDS,SECS
  6781.          SCABBR SEPARATOR,SEP
  6782.          SCABBR SHARED,SHR
  6783.          SCABBR SHIFTIN,SI
  6784.          SCABBR SHIFTOUT,SO
  6785.          SCABBR SHOW,SH
  6786.          SCABBR SPACE,SP
  6787.          SCABBR SPACES,SPS
  6788.          SCABBR SPACING,SPN
  6789.          SCABBR SPLIT,SPL,(S)
  6790.          SCABBR STARTBLINK,SBK
  6791.          SCABBR STARTBOLD,SBD
  6792.          SCABBR STARTFIELD,SFD
  6793.          SCABBR STARTREVERSE,SRV
  6794.          SCABBR STARTUNDERLINE,SUL
  6795.          SCABBR STATEMENT,STMT
  6796.          SCABBR STATEMENTS,STMTS
  6797.          SCABBR STATUS,STAT
  6798.          SCABBR STOPCODE,SC
  6799.          SCABBR STORAGE,STOR
  6800.          SCABBR STRING,STR
  6801.          SCABBR STRINGM,STRM
  6802.          SCABBR STRINGZ,STRZ
  6803.          SCABBR SUBSTITUTE,SUBST
  6804.          SCABBR SUBSTRING,SUBSTR
  6805.          SCABBR SUBSTRINGA,SUBSTRA
  6806.          SCABBR SUBTITLE,SUBTTL
  6807.          SCABBR SUGGEST,SUG
  6808.          SCABBR TABLE,TBL
  6809.          SCABBR TEMPORARY,TEMP
  6810.          SCABBR TERMINAL,TERM
  6811.          SCABBR TERMINATE,TERM
  6812.          SCABBR TERSE,TER
  6813.          SCABBR TEXT,TXT,TX
  6814.          SCABBR TITLE,TTL
  6815.          SCABBR TRACK,TRK
  6816.          SCABBR TRACKS,TRKS
  6817.          SCABBR TRIPLE,TRI,TPL
  6818.          SCABBR TRUNCATE,TRUNC
  6819.          SCABBR TYPE,TYP,(T)
  6820.          SCABBR UNCATALOG,UNCAT,UNCTLG,UNCATLG
  6821.          SCABBR UNDERLINE,UNDL,ULINE
  6822.          SCABBR UNDERLINED,UNDLD,ULINED
  6823.          SCABBR UNDERSCORE,UNDSC,USCORE
  6824.          SCABBR UNFLAGGED,UNFLGD,UFLGD
  6825.          SCABBR UNNUMBERED,UNN
  6826.          SCABBR UPLOW,UPL
  6827.          SCABBR UPPER,UPP,UPR
  6828.          SCABBR USING,USN
  6829.          SCABBR VARIABLE,VAR
  6830.          SCABBR VARIABLES,VARS
  6831.          SCABBR VERBATIM,VBTM,VB
  6832.          SCABBR VERIFY,VER
  6833.          SCABBR VERIFYA,VERA
  6834.          SCABBR VERIFYN,VERN
  6835.          SCABBR VERIFYNA,VERNA
  6836.          SCABBR VERTICALBAR,VBAR
  6837.          SCABBR VERTICALTAB,VTAB
  6838.          SCABBR VIEW,(V)
  6839.          SCABBR VOLUME,VOL
  6840.          SCABBR VOLUMES,VOLS
  6841.          SCABBR WIDTH,WID
  6842.          SCABBR WYLBUR,WYL
  6843.          SCABBR YES,Y
  6844.          MEND
  6845. ./       ADD   LIST=ALL,NAME=SCAN
  6846.          MACRO
  6847. &L       SCAN  &PRT,&BRANCH=,&LIMIT=,&SCT=SCTSTART
  6848.          GBLC  &SCANEND(10),&SCANPRT(10)
  6849.          GBLA  &SCANCNT
  6850.          GBLA  &SCANNDX
  6851. &SCANNDX SETA  &SCANNDX+1
  6852.          SYSKWT BRANCH,&BRANCH,(YES,NO)
  6853. .*
  6854.          AIF   ('&PRT' EQ '*').STAR
  6855. &L       SYSLR VR1,&PRT,TYPE=&BRANCH,SELECT=(NO)
  6856.          SYSLR VR0,&LIMIT
  6857.          SYSLR VRF,&SCT
  6858.          SCCALL SCAN
  6859.          MEXIT
  6860. .*
  6861. .STAR    ANOP
  6862. &SCANCNT SETA  &SCANCNT+1
  6863. &SCANEND(&SCANCNT) SETC 'SCN&SCANNDX.E'
  6864. &SCANPRT(&SCANCNT) SETC 'SCN&SCANNDX.T'
  6865. &L       SYSLR VR1,SCN&SCANNDX.T,TYPE=&BRANCH,SELECT=(NO)
  6866.          SYSLR VR0,&LIMIT
  6867.          SYSLR VRF,&SCT
  6868.          SCCALL SCAN
  6869.          B     &SCANEND(&SCANCNT)
  6870. SCN&SCANNDX.T DS 0X
  6871.          MEND
  6872. ./       ADD   LIST=ALL,NAME=SCANEND
  6873.          MACRO
  6874. &L       SCANEND
  6875.          GBLC  &SCANEND(10)
  6876.          GBLA  &SCANCNT
  6877.          AIF   (&SCANCNT GE 0).OK
  6878.          MNOTE 12,'NO MATCHING SCAN *'
  6879.          MEXIT
  6880. .*
  6881. .OK      ANOP
  6882. &L       SYSLBL
  6883. &SCANEND(&SCANCNT) SYSLBL
  6884. &SCANCNT SETA  &SCANCNT-1
  6885.          MEND
  6886. ./       ADD   LIST=ALL,NAME=SCBACK
  6887.          MACRO
  6888. &L       SCBACK &SCT=SCTSTART
  6889. &L       MMVC  SCTLEN-SCTSTART+&SCT,SCTBLEN-SCTSTART+&SCT,8
  6890.          MEND
  6891. ./       ADD   LIST=ALL,NAME=SCCALL
  6892.          MACRO
  6893. &L       SCCALL &R,&RETURN=
  6894. &L       CCALL &R,RETURN=&RETURN
  6895.          MEND
  6896. ./       ADD   LIST=ALL,NAME=SCDONE
  6897.          MACRO
  6898. &L       SCDONE &SCT=SCTSTART
  6899.          GBLA  &SCANNDX
  6900. &SCANNDX SETA  &SCANNDX+1
  6901. .*
  6902. &L       SCAN  SCT=&SCT
  6903.          BNP   SCD&SCANNDX.X
  6904.          SCERROR OLD=RTNR,SCT=&SCT
  6905.          LI    VRF,SCTCSCD
  6906.          SCCALL (RTNR)
  6907. SCD&SCANNDX.X DS 0H
  6908.          MEND
  6909. ./       ADD   LIST=ALL,NAME=SCDQUOTE
  6910.          MACRO
  6911. &L       SCDQUOTE &LOC,&LEN,&SCT=
  6912. &L       SYSQS VR1,VR0,&LOC,&LEN
  6913.          SCCALL SCDQUOTE
  6914.          MEND
  6915. ./       ADD   LIST=ALL,NAME=SCERROR
  6916.          MACRO
  6917. &L       SCERROR &NEW=,&OLD=,&NEWPARM=,&OLDPARM=,&SCT=SCTSTART
  6918.          LCLC  &LBL
  6919. .*
  6920. &LBL     SETC  '&L'
  6921. .*
  6922.          AIF   ('&NEW&OLD' EQ '' AND '&NEWPARM&OLDPARM' NE '').PARM
  6923. &LBL     SYSLST SCTERROR-SCTSTART+&SCT,NEW=&NEW,OLD=&OLD
  6924. &LBL     SETC  ''
  6925.          AIF   ('&NEWPARM&OLDPARM' EQ '').END
  6926. .*
  6927. .PARM    ANOP
  6928. &LBL     SYSLST SCTERRP-SCTSTART+&SCT,NEW=&NEWPARM,OLD=&OLDPARM
  6929. .END     MEND
  6930. ./       ADD   LIST=ALL,NAME=SCEXTRA
  6931.          MACRO
  6932. &L       SCEXTRA
  6933. &L       SCAN  *
  6934.          SCKW  ,*,B
  6935.          SCANEND
  6936.          MEND
  6937. ./       ADD   LIST=ALL,NAME=SCINIT
  6938.          MACRO
  6939. &L       SCINIT &LOC,&LEN,&SCT=SCTSTART
  6940. &L       MZC   SCTINIT-SCTSTART+&SCT,SCTINITL
  6941.          AIF   ('&LEN,&LOC' EQ '(VRE),(VRF)').STM
  6942.          AIF   ('&LEN,&LOC' EQ '(VRF),(VR0)').STM
  6943.          AIF   ('&LEN,&LOC' EQ '(VR0),(VR1)').STM
  6944.          AIF   ('&LEN,&LOC' EQ '(VR1),(XRA)').STM
  6945.          AIF   ('&LEN,&LOC' EQ '(XRA),(XRB)').STM
  6946.          AIF   ('&LEN,&LOC' EQ '(XRB),(XRC)').STM
  6947.          AIF   ('&LEN,&LOC' EQ '(XRC),(XRD)').STM
  6948.          AIF   ('&LEN,&LOC' EQ '(XRD),(XRE)').STM
  6949.          AIF   ('&LEN,&LOC' EQ '(XRE),(XRF)').STM
  6950. .*
  6951.          AIF   ('&LEN' EQ '').LRLEN
  6952.          AIF   ('&LEN'(1,1) NE '(').LRLEN
  6953.          ST    &LEN,SCTLEN-SCTSTART+&SCT
  6954.          AGO   .LOC
  6955. .*
  6956. .LRLEN   ANOP
  6957.          SYSLR RTNR,&LEN,ERR='LENGTH MISSING'
  6958.          ST    RTNR,SCTLEN-SCTSTART+&SCT
  6959. .*
  6960. .LOC     ANOP
  6961.          AIF   ('&LOC' EQ '').LRLOC
  6962.          AIF   ('&LOC'(1,1) NE '(').LRLOC
  6963.          ST    &LOC,SCTLOC-SCTSTART+&SCT
  6964.          MEXIT
  6965. .*
  6966. .LRLOC   ANOP
  6967.          SYSLR RTNR,&LOC,ERR='LOCATION MISSING'
  6968.          ST    RTNR,SCTLOC-SCTSTART+&SCT
  6969.          MEXIT
  6970. .*
  6971. .STM     ANOP
  6972.          STM   &LEN,&LOC,SCTLEN-SCTSTART+&SCT
  6973.          MEND
  6974. ./       ADD   LIST=ALL,NAME=SCKW
  6975.          MACRO
  6976. &L       SCKW  &WORD,&RTN,&OPTS,&LIMIT=,&CODE=
  6977.          GBLC  &SCKWABR(50)
  6978.          GBLA  &SCKWN
  6979.          GBLB  &SCKWHD,&SCKWAC
  6980.          GBLC  &SCKWAVS,&SCKWRTN
  6981.          GBLA  &SCKWAVC
  6982.          GBLC  &SCKWTBL(42)
  6983.          LCLA  &X,&Y,&Z,&TYPE,&LIML,&CODL
  6984.          LCLB  &B,&J,&P,&TL
  6985.          LCLC  &CH,&LBL
  6986. .*
  6987. &LBL     SETC  '&L'
  6988.          SCKWR INIT
  6989. .*
  6990. &SCKWAC  SETB  0
  6991. .LOOP    ANOP
  6992. &X       SETA  &X+1
  6993.          AIF   (&X GT N'&OPTS).LOOPEND
  6994.          AIF   ('&OPTS(&X)' EQ 'P').P
  6995.          AIF   ('&OPTS(&X)' EQ 'I').I
  6996.          AIF   ('&OPTS(&X)' EQ 'PI').PI
  6997.          AIF   ('&OPTS(&X)' EQ 'O').O
  6998.          AIF   ('&OPTS(&X)' EQ 'PO').PO
  6999.          AIF   ('&OPTS(&X)' EQ 'LN').LN
  7000.          AIF   ('&OPTS(&X)' EQ 'PLN').PLN
  7001.          AIF   ('&OPTS(&X)' EQ 'QS').QS
  7002.          AIF   ('&OPTS(&X)' EQ 'OQS').OQS
  7003.          AIF   ('&OPTS(&X)' EQ 'PS').PS
  7004.          AIF   ('&OPTS(&X)' EQ 'OPS').OPS
  7005.          AIF   ('&OPTS(&X)' EQ 'B').B
  7006.          AIF   ('&OPTS(&X)' EQ 'J').J
  7007.          AIF   ('&OPTS(&X)' EQ 'SC').SC
  7008.          AIF   ('&OPTS(&X)' EQ 'SCI').SCI
  7009.          AIF   ('&OPTS(&X)' EQ 'AC').AC
  7010.          AIF   ('&OPTS(&X)' EQ 'VC').VC
  7011.          AIF   ('&OPTS(&X)' EQ 'C').C
  7012.          AIF   ('&OPTS(&X)' EQ 'TL').TL
  7013.          MNOTE 12,'"&OPTS(&X)" IS AN ILLEGAL OPTION'
  7014.          AGO   .LOOP
  7015. .*
  7016. .*  P
  7017. .*
  7018. .P       ANOP
  7019. &P       SETB  1
  7020.          AGO   .LOOP
  7021. .*
  7022. .*  I
  7023. .*
  7024. .I       ANOP
  7025. &TYPE    SETA  1
  7026.          AGO   .LOOP
  7027. .*
  7028. .*  PI
  7029. .*
  7030. .PI      ANOP
  7031. &TYPE    SETA  2
  7032.          AGO   .LOOP
  7033. .*
  7034. .*  O
  7035. .*
  7036. .O       ANOP
  7037. &TYPE    SETA  3
  7038.          AGO   .LOOP
  7039. .*
  7040. .*  PO
  7041. .*
  7042. .PO      ANOP
  7043. &TYPE    SETA  4
  7044.          AGO   .LOOP
  7045. .*
  7046. .*  LN
  7047. .*
  7048. .LN      ANOP
  7049. &TYPE    SETA  5
  7050.          AGO   .LOOP
  7051. .*
  7052. .*  PLN
  7053. .*
  7054. .PLN     ANOP
  7055. &TYPE    SETA  6
  7056.          AGO   .LOOP
  7057. .*
  7058. .*  QS
  7059. .*
  7060. .QS      ANOP
  7061. &TYPE    SETA  7
  7062.          AGO   .LOOP
  7063. .*
  7064. .*  OQS
  7065. .*
  7066. .OQS     ANOP
  7067. &TYPE    SETA  8
  7068.          AGO   .LOOP
  7069. .*
  7070. .*  PS
  7071. .*
  7072. .PS      ANOP
  7073. &TYPE    SETA  9
  7074.          AGO   .LOOP
  7075. .*
  7076. .*  OPS
  7077. .*
  7078. .OPS     ANOP
  7079. &TYPE    SETA  10
  7080.          AGO   .LOOP
  7081. .*
  7082. .*  B
  7083. .*
  7084. .B       ANOP
  7085. &B       SETB  1
  7086.          AGO   .LOOP
  7087. .*
  7088. .*  J
  7089. .*
  7090. .J       ANOP
  7091. &J       SETB  1
  7092.          AGO   .LOOP
  7093. .*
  7094. .*  SC
  7095. .*
  7096. .SC      ANOP
  7097. &SCKWAVS SETC  'SL2'
  7098. &SCKWAVC SETA  2
  7099.          AGO   .LOOP
  7100. .*
  7101. .*  SCI
  7102. .*
  7103. .SCI     ANOP
  7104. &SCKWAVS SETC  'SL2'
  7105. &SCKWAVC SETA  3
  7106.          AGO   .LOOP
  7107. .*
  7108. .*  AC
  7109. .*
  7110. .AC      ANOP
  7111. &SCKWAVS SETC  'AL4'
  7112. &SCKWAVC SETA  0
  7113.          AGO   .LOOP
  7114. .*
  7115. .*  VC
  7116. .*
  7117. .VC      ANOP
  7118. &SCKWAVS SETC  'VL4'
  7119. &SCKWAVC SETA  1
  7120.          AGO   .LOOP
  7121. .*
  7122. .C       ANOP
  7123. &SCKWAC  SETB  1
  7124.          AGO   .LOOP
  7125. .*
  7126. .TL      ANOP
  7127. &TL      SETB  1
  7128.          AGO   .LOOP
  7129. .*
  7130. .LOOPEND ANOP
  7131. .*
  7132.          SCKWR ADDR,&RTN
  7133. .*
  7134.          AIF   ('&LIMIT' EQ '').NLIM
  7135.          AIF   (K'&LIMIT LT 4).ERRLIM
  7136.          AIF   ('&LIMIT'(1,2) EQ 'AL').LIML
  7137.          AIF   ('&LIMIT'(1,2) EQ 'YL').LIML
  7138.          AIF   ('&LIMIT'(1,2) EQ 'FL').LIML
  7139.          AIF   ('&LIMIT'(1,2) EQ 'HL').LIML
  7140.          AIF   ('&LIMIT'(1,2) EQ 'XL').LIML
  7141.          AIF   ('&LIMIT'(1,2) EQ 'BL').LIML
  7142.          AIF   ('&LIMIT'(1,2) EQ 'CL').LIML
  7143. .ERRLIM  MNOTE 12,'ILLEGAL LIMIT'
  7144.          AGO   .NLIM
  7145. .*
  7146. .LIML    ANOP
  7147.          AIF   ('&LIMIT'(2,1) NE 'L').ERRLIM
  7148. &CH      SETC  '&LIMIT'(3,1)
  7149.          AIF   ('&CH' NE '1' AND '&CH' NE '2' AND '&CH' NE '4').ERRLIM
  7150. &LIML    SETA  &CH
  7151.          AIF   ('&LIMIT'(4,1) NE '(' AND '&LIMIT'(4,1) NE '''').ERRLIM
  7152. &LIML    SETA  &LIML-&LIML/4
  7153. .NLIM    ANOP
  7154. .*
  7155.          AIF   ('&CODE' EQ '').NCOD
  7156.          AIF   (K'&CODE LT 4).ERRCOD
  7157.          AIF   ('&CODE'(1,2) EQ 'AL').CODL
  7158.          AIF   ('&CODE'(1,2) EQ 'YL').CODL
  7159.          AIF   ('&CODE'(1,2) EQ 'FL').CODL
  7160.          AIF   ('&CODE'(1,2) EQ 'HL').CODL
  7161.          AIF   ('&CODE'(1,2) EQ 'XL').CODL
  7162.          AIF   ('&CODE'(1,2) EQ 'BL').CODL
  7163.          AIF   ('&CODE'(1,2) EQ 'CL').CODL
  7164. .ERRCOD  MNOTE 12,'ILLEGAL CODE'
  7165.          AGO   .NCOD
  7166. .*
  7167. .CODL    ANOP
  7168.          AIF   ('&CODE'(2,1) NE 'L').ERRCOD
  7169. &CH      SETC  '&CODE'(3,1)
  7170.          AIF   ('&CH' NE '1' AND '&CH' NE '2' AND '&CH' NE '4').ERRCOD
  7171. &CODL    SETA  &CH
  7172.          AIF   ('&CODE'(4,1) NE '(' AND '&CODE'(4,1) NE '''').ERRCOD
  7173. &CODL    SETA  &CODL-&CODL/4
  7174. .NCOD    ANOP
  7175. .*
  7176. &SCKWN   SETA  0
  7177. &SCKWHD  SETB  0
  7178. &X       SETA  0
  7179. .WLOOP   ANOP
  7180. &X       SETA  &X+1
  7181.          AIF   (&X GT N'&WORD).WDONE
  7182.          AIF   ('&WORD(&X)' EQ '').WLOOP
  7183.          AIF   ('&WORD(&X)'(1,1) EQ '''').WQ
  7184.          SCKWA '&WORD(&X)'
  7185.          AGO   .WLOOP
  7186. .*
  7187. .WQ      SCKWA &WORD(&X)
  7188.          AGO   .WLOOP
  7189. .*
  7190. .WDONE   ANOP
  7191. .*
  7192. &X       SETA  0
  7193. &Y       SETA  0
  7194. .GLOOP   ANOP
  7195. .*
  7196.          AIF   ('&SCKWTBL(1)' EQ '').NTBLP
  7197. &Z       SETA  0
  7198.          AIF   (&SCKWN LT 1).TBLP
  7199.          AIF   (&X EQ 0).TBLPC
  7200.          AIF   (&X+1 GT &SCKWN).NTBLP
  7201.          AIF   ('&SCKWABR(&X)'(2,1) EQ '&SCKWABR(&X+1)'(2,1)).NTBLP
  7202. .TBLPC   ANOP
  7203.          AIF   ('&SCKWABR(&X+1)'(2,1) LT 'A').TBLP
  7204.          AIF   ('&SCKWABR(&X+1)'(2,1) GT 'Z').TBLP
  7205. &CH      SETC  'C'''.'&SCKWABR(&X+1)'(2,1).''''
  7206. &Z       SETA  &CH-C'A'+1
  7207. .TBLP    ANOP
  7208. &LBL     SYSLBL TYPE=X
  7209. &LBL     SETC  ''
  7210. &Z       SETA  &Z+1
  7211. &SCKWTBL(&Z) SCKWTBLP &Z
  7212. .NTBLP   ANOP
  7213. .*
  7214. &X       SETA  &X+1
  7215.          AIF   (&X GT &SCKWN).GDONE
  7216.          AIF   (&X+1 GT &SCKWN).NA3
  7217.     AIF ('&SCKWABR(&X)' NE '&SCKWABR(&X+1)    '(1,2).'''').NA1
  7218. &Y       SETA  &Y+1
  7219.          AGO   .GLOOP
  7220. .*
  7221. .NA1     ANOP
  7222.     AIF ('&SCKWABR(&X)' NE '&SCKWABR(&X+1)    '(1,3).'''').NA2
  7223. &Y       SETA  &Y+2
  7224.          AGO   .GLOOP
  7225. .*
  7226. .NA2     ANOP
  7227.     AIF ('&SCKWABR(&X)' NE '&SCKWABR(&X+1)    '(1,4).'''').NA3
  7228. &Y       SETA  &Y+4
  7229.          AGO   .GLOOP
  7230. .*
  7231. .NA3     ANOP
  7232. &LBL     SCKWB &SCKWABR(&X),&Y
  7233. &LBL     SETC  ''
  7234. &Y       SETA  0
  7235. .*
  7236.          AIF   ('&SCKWTBL(1)' EQ '').GLOOP
  7237.          AIF   (&X+1 GT &SCKWN).GLOOP
  7238.          AIF   ('&SCKWABR(&X)'(2,1) EQ '&SCKWABR(&X+1)'(2,1)).GLOOP
  7239. .*
  7240. .GDONE   ANOP
  7241. .*
  7242. &LBL     DC    AL.1(1),AL.1(0),AL.2(&SCKWAVC),AL.2(&LIML),AL.2(&CODL)
  7243. &LBL     SETC  ''
  7244.          DC    AL.1(&TL),AL.1(&P),AL.1(&B),AL.1(&J),AL.4(&TYPE)
  7245.          DC    &SCKWAVS.(&SCKWRTN)
  7246.          AIF   ('&LIMIT' EQ '').NGLIM
  7247.          DC    &LIMIT
  7248. .NGLIM   ANOP
  7249. .*
  7250.          AIF   ('&CODE' EQ '').NGCOD
  7251.          DC    &CODE
  7252. .NGCOD   ANOP
  7253. .*
  7254.          AIF   (&X LT &SCKWN).GLOOP
  7255. .*
  7256. .END     MEND
  7257. ./       ADD   LIST=ALL,NAME=SCKWA
  7258.          MACRO
  7259.          SCKWA &W,&SW
  7260.          GBLC  &SCKWABR(50)
  7261.          GBLA  &SCKWN
  7262.          GBLB  &SCKWHD,&SCKWAC
  7263.          GBLC  &SCABWRD(400),&SCABABR(500)
  7264.          GBLA  &SCABP(400),&SCABC(400),&SCABN,&SCABAN
  7265.          GBLB  &SCABAC(500)
  7266.          LCLC  &A,&B
  7267.          LCLA  &X,&Y,&Z
  7268. .*
  7269. &A       SETC  '&W                '(1,16)
  7270.          AIF   (K'&W LE 16).LENOK
  7271. &A       SETC  '&A'(1,15).''''
  7272. .LENOK   ANOP
  7273. .*
  7274. .TLOOP   ANOP
  7275. &X       SETA  &X+1
  7276.          AIF   (&X GT &SCKWN).TDONE
  7277. &B       SETC  '&SCKWABR(&X)                '(1,16)
  7278.          AIF   ('&A' GT '&B').TLOOP
  7279.          AIF   ('&A' LT '&B').TDONE
  7280.          AIF   ('&SW' NE '').END
  7281.          MNOTE 12,'WORD BELOW IS DUPLICATED'
  7282.          MNOTE 12,&W
  7283. &SCKWHD  SETB  0
  7284.          AGO   .END
  7285. .*
  7286. .TDONE   ANOP
  7287. .*
  7288.          AIF   (&SCKWN LT 50).OK
  7289.          MNOTE 12,'SCKW TABLE OVERFLOW'
  7290.          MEXIT
  7291. .*
  7292. .OK      ANOP
  7293. .*
  7294. &SCKWN   SETA  &SCKWN+1
  7295.          AIF   (&X GE &SCKWN).MDONE
  7296. &Y       SETA  &SCKWN+1
  7297. .MLOOP   ANOP
  7298. &Y       SETA  &Y-1
  7299.          AIF   (&Y LE &X).MDONE
  7300. &SCKWABR(&Y) SETC '&SCKWABR(&Y-1)'
  7301.          AGO   .MLOOP
  7302. .*
  7303. .MDONE   ANOP
  7304. &SCKWABR(&X) SETC '&W'
  7305.          AIF   (K'&W LE 16).MN2
  7306. &SCKWABR(&X) SETC '&SCKWABR(&X)'(1,15).''''
  7307. .MN2     ANOP
  7308. .*
  7309.          AIF   (&SCABN LT 1).END
  7310. &X       SETA  1
  7311. &Y       SETA  &SCABN
  7312. .BLOOP   ANOP
  7313.          AIF   (&X GT &Y).END
  7314. &Z       SETA  &X+(&Y-&X)/2
  7315. &B       SETC  '&SCABWRD(&Z)                '(1,16)
  7316.          AIF   ('&A' EQ '&B').BFOUND
  7317.          AIF   (&X EQ &Y).END
  7318.          AIF   ('&A' LT '&B').BLEFT
  7319. &X       SETA  &Z+1
  7320.          AGO   .BLOOP
  7321. .*
  7322. .BLEFT   ANOP
  7323. &Y       SETA  &Z-1
  7324.          AGO   .BLOOP
  7325. .*
  7326. .BFOUND  ANOP
  7327. &X       SETA  &SCABP(&Z)-1
  7328. &Y       SETA  &SCABC(&Z)
  7329. .*
  7330. .CLOOP   ANOP
  7331. &X       SETA  &X+1
  7332. &Y       SETA  &Y-1
  7333.          AIF   (&Y LT 0).END
  7334.          AIF   (&SCABAC(&X) AND NOT &SCKWAC).CLOOP
  7335.          AIF   (&SCKWHD).NHD
  7336. &SCKWHD  SETB  1
  7337.          MNOTE *,'ABBREVIATIONS/SYNONYMS'
  7338. .NHD     MNOTE *,&SCABABR(&X)
  7339.          SCKWA &SCABABR(&X),NO
  7340.          AGO   .CLOOP
  7341. .*
  7342. .END     MEND
  7343. ./       ADD   LIST=ALL,NAME=SCKWB
  7344.          MACRO
  7345. &L       SCKWB &W,&A
  7346.          LCLA  &X,&LEN
  7347. .*
  7348. &X       SETA  1
  7349. .COUNT   ANOP
  7350. &X       SETA  &X+1
  7351.          AIF   (&X GT K'&W-1).COUNTED
  7352. &LEN     SETA  &LEN+1
  7353.     AIF ('&W'(&X,2) NE ''''''(1,2) AND '&W'(&X,2) NE '&&&&'(1,2)).COUNT
  7354. &X       SETA  &X+1
  7355.          AGO   .COUNT
  7356. .*
  7357. .COUNTED ANOP
  7358. &L       DC    AL.1(0),AL.3(&A),AL.4(&LEN),C&W
  7359.          MEND
  7360. ./       ADD   LIST=ALL,NAME=SCKWR
  7361.          MACRO
  7362. &L       SCKWR &TYPE,&RTN
  7363.          GBLC  &SCANEND(10)
  7364.          GBLA  &SCANCNT
  7365.          GBLC  &SCKWAVS,&SCKWRTN
  7366.          GBLA  &SCKWAVC
  7367.          LCLA  &X
  7368.          AIF   ('&TYPE' EQ 'INIT').INIT
  7369.          AIF   ('&TYPE' EQ 'ADDR').ADDR
  7370.          MNOTE 12,'SCKWR &TYPE IS ILLEGAL'
  7371.          MEXIT
  7372. .*
  7373. .INIT    ANOP
  7374. &SCKWAVS SETC  'AL4'
  7375. &SCKWAVC SETA  0
  7376. &SCKWRTN SETC '0'
  7377.          MEXIT
  7378. .*
  7379. .ADDR    ANOP
  7380.          AIF   ('&RTN' EQ '' OR '&RTN' EQ '0').ZSC
  7381.          AIF   ('&RTN' EQ '*').STAR
  7382. &SCKWRTN SETC  '&RTN'
  7383.          MEXIT
  7384. .*
  7385. .STAR    ANOP
  7386.          AIF   (&SCANCNT LE 0).STARERR
  7387. &SCKWRTN SETC  '&SCANEND(&SCANCNT)'
  7388.          MEXIT
  7389. .*
  7390. .STARERR ANOP
  7391.          MNOTE 12,'SCKW * MUST BE IN RANGE OF SCAN *'
  7392. .*
  7393. .ZSC     ANOP
  7394. &SCKWRTN SETC '0'
  7395. &SCKWAVS SETC  'SL2'
  7396. &SCKWAVC SETA  2
  7397.          MEND
  7398. ./       ADD   LIST=ALL,NAME=SCKWTBL
  7399.          MACRO
  7400. &L       SCKWTBL &TYPE
  7401.          GBLC  &SCKWTBL(42)
  7402.          LCLA  &X
  7403.          LCLC  &LBL
  7404. .*
  7405.          AIF   ('&TYPE' EQ 'BEGIN').BEGIN
  7406.          AIF   ('&TYPE' EQ 'END').END
  7407.          MNOTE 12,'"&TYPE" IS ILLEGAL'
  7408. &L       SYSLBL TYPE=X
  7409.          MEXIT
  7410. .*
  7411. .BEGIN   ANOP
  7412.          AIF   ('&SCKWTBL(1)' EQ '').BEGOK
  7413.          MNOTE 12,'MISSING SCKWTBL END'
  7414.          SCKWTBL END
  7415. .BEGOK   ANOP
  7416. &LBL     SETC  '&L'
  7417. .BEGLOOP ANOP
  7418. &X       SETA  &X+1
  7419. &LBL     SCKWTBLP &X
  7420. &LBL     SETC  ''
  7421.          AIF   (&X LT 42).BEGLOOP
  7422.          MEXIT
  7423. .*
  7424. .END     ANOP
  7425. &L       SYSLBL TYPE=X
  7426.          AIF   ('&SCKWTBL(1)' NE '').ENDOK
  7427.          MNOTE 12,'NO MATCHING SCKWTBL BEGIN'
  7428.          MEXIT
  7429. .ENDOK   ANOP
  7430. .ENDLOOP ANOP
  7431. &X       SETA  &X+1
  7432. &SCKWTBL(&X) EQU 0
  7433. &SCKWTBL(&X) SETC ''
  7434.          AIF   (&X LT 42).ENDLOOP
  7435.          MEND
  7436. ./       ADD   LIST=ALL,NAME=SCKWTBLP
  7437.          MACRO
  7438. &L       SCKWTBLP &X
  7439.          GBLC  &SCKWTBL(42)
  7440. &SCKWTBL(&X) SETC 'SCKW&SYSNDX'
  7441. &L       DC    AL4(&SCKWTBL(&X))
  7442.          MEND
  7443. ./       ADD   LIST=ALL,NAME=SCLAST
  7444.          MACRO
  7445. &L       SCLAST &SCT=SCTSTART
  7446. &L       LM    VR0,VR1,SCTTLEN-SCTSTART+&SCT
  7447.          MEND
  7448. ./       ADD   LIST=ALL,NAME=SCPOP
  7449.          MACRO
  7450. &L       SCPOP &SCT=SCTSTART
  7451. &L       MZC   SCTINIT-SCTSTART+&SCT,SCTINITL
  7452.          SCPOPA 8
  7453.          MMVC  SCTLEN-SCTSTART+&SCT,0(STKR),8
  7454.          MEND
  7455. ./       ADD   LIST=ALL,NAME=SCPOPA
  7456.          MACRO
  7457. &L       SCPOPA &S
  7458. &L       CPOP  ,&S
  7459.          MEND
  7460. ./       ADD   LIST=ALL,NAME=SCPUSH
  7461.          MACRO
  7462. &L       SCPUSH &SCT=SCTSTART
  7463. &L       MMVC  0(STKR),SCTLEN-SCTSTART+&SCT,8
  7464.          SCPUSHA 8
  7465.          MEND
  7466. ./       ADD   LIST=ALL,NAME=SCPUSHA
  7467.          MACRO
  7468. &L       SCPUSHA &S
  7469. &L       CPUSH ,&S
  7470.          MEND
  7471. ./       ADD   LIST=ALL,NAME=SCRTN
  7472.          MACRO
  7473. &L       SCRTN &PRT,&RTNR=YES,&SCT=SCTSTART
  7474.          GBLC  &SCANPRT(10)
  7475.          GBLA  &SCANCNT
  7476.          LCLC  &LBL
  7477.          SYSKWT RTNR,&RTNR,(YES,NO),COND=NO,NULL=NO
  7478. .*
  7479. &LBL     SETC  '&L'
  7480. .*
  7481.          AIF   ('&PRT' EQ '').NPRT
  7482.          AIF   ('&PRT' NE '*').NSTAR
  7483.          AIF   (&SCANCNT GT 0).STAR
  7484.          MNOTE 12,'SCRTN * MUST BE IN RANGE OF SCAN *'
  7485.          AGO   .NPRT
  7486. .*
  7487. .STAR    ANOP
  7488. &LBL     SYSLR VR1,&SCANPRT(&SCANCNT)
  7489. &LBL     SETC  ''
  7490.          ST    VR1,SCTSCKWS-SCTSTART+&SCT
  7491.          AGO   .NPRT
  7492. .*
  7493. .NSTAR   ANOP
  7494. &LBL     SYSLR VR1,&PRT
  7495. &LBL     SETC  ''
  7496.          ST    VR1,SCTSCKWS-SCTSTART+&SCT
  7497. .NPRT    ANOP
  7498. .*
  7499.          AIF   ('&RTNR' NE 'YES').NRTNR
  7500. &LBL     BR    RTNR
  7501.          MEXIT
  7502. .*
  7503. .NRTNR   ANOP
  7504. &LBL     B     SCTRET-SCTSTART+&SCT
  7505.          MEND
  7506. ./       ADD   LIST=ALL,NAME=SCSEMI
  7507.          MACRO
  7508. &L       SCSEMI &SCT=SCTSTART
  7509. &L       L     RTNR,SCTLEN-SCTSTART+&SCT
  7510.          LTR   RTNR,RTNR
  7511.          BNP   SCSC&SYSNDX
  7512.          L     RTNR,SCTLOC-SCTSTART+&SCT
  7513.          CLI   0(RTNR),C';'
  7514.          BNE   SCSC&SYSNDX
  7515.          LA    RTNR,1(,RTNR)
  7516.          ST    RTNR,SCTLOC-SCTSTART+&SCT
  7517.          L     RTNR,SCTLEN-SCTSTART+&SCT
  7518.          BCTR  RTNR,0
  7519.          ST    RTNR,SCTLEN-SCTSTART+&SCT
  7520. SCSC&SYSNDX DS 0H
  7521.          MEND
  7522. ./       ADD   LIST=ALL,NAME=SCT
  7523.          MACRO
  7524. &L       SCT
  7525.          GBLA  &LSCAN
  7526. &L       SYSLBL TYPE=F
  7527. *
  7528. *  NIH/COMMON - SCAN CONTROL TABLE
  7529. *
  7530. SCTSTART DS    0F
  7531. *
  7532. SCTINIT  DS    0F                      START OF AREA TO INITIALIZE
  7533. *
  7534. SCTLEN   DC    F'0'                    LENGTH REMAINING
  7535. SCTLOC   DC    A(0)                    CURRENT LOCATION
  7536. SCTBLEN  DC    F'0'                    LENGTH FOR SCBACK
  7537. SCTBLOC  DC    A(0)                    LOCATION FOR SCBACK
  7538. SCTTLEN  DC    F'0'                    LENGTH OF LAST TOKEN
  7539. SCTTLOC  DC    A(0)                    LOCATION OF LAST TOKEN
  7540. *
  7541. SCTINITL EQU   *-SCTINIT
  7542. *
  7543. SCTERROR DC    A(0)                    LOCATION OF ERROR ROUTINE
  7544. SCTERRP  DC    A(0)                    PARAMETER FOR ERROR ROUTINE
  7545. SCTRTN   DC    A(0)                    SAVED RETURN ADDRESS
  7546. SCTSCKWS DC    A(0)                    SAVED ADDRESS OF SCKW LIST
  7547. SCTTYPE  DC    F'0'                    SCAN TYPE/TABLE
  7548. SCTTOKEN DC    CL&LSCAN.' '            TOKEN PADDED WITH BLANKS
  7549. *
  7550. SCTS370  DC    4F'0'                   370 SIMULATION AREA
  7551.          ORG   SCTS370                 OVERLAY WITH LINKAGE
  7552. *
  7553. SCTCALL  DS    0F                      LINKAGE TO PROCESSING ROUTINE
  7554.          CBASE RTNR                    GET BASE
  7555. SCTBASE1 L     RTNR,SCTENTRY-SCTBASE1(,RTNR)  ENTRY ADDRESS
  7556.          CBALR RTNR,RTNR               CALL PROCESSING ROUTINE
  7557. SCTRET   CBASE VRF                     GET BASE ON RETURN
  7558. SCTBASE2 L     RTNR,SCTREENT-SCTBASE2(,VRF)  ENTRY ADDR FOR SCANNER
  7559.          BR    RTNR                    GO TO SCANNER
  7560. SCTREENT DC    A(0)                    SCANNER ADDRESS
  7561. SCTCALLL EQU   *-SCTCALL               LENGTH OF LINKAGE
  7562. SCTENTRY DC    A(0)                    ENTRY POINT OF PROCESSING RTN
  7563. *
  7564.          DS    0F
  7565. SCTSIZE  EQU   *-SCTSTART
  7566. *
  7567. *  ENTRY CODES FOR ERROR ROUTINE
  7568. *
  7569. SCTCUBQ  EQU   00                      UNBALANCED QUOTES
  7570. SCTCUBP  EQU   04                      UNBALANCED PARENTHESES
  7571. SCTCIXM  EQU   08                      INTEGER EXCEEDS MAXIMUM
  7572. SCTCOXM  EQU   12                      ORDINAL EXCEEDS MAXIMUM
  7573. SCTCLNXM EQU   16                      LINE NUMBER EXCEEDS MAXIMUM
  7574. SCTCZNG  EQU   20                      "POSITIVE" VALUE WAS ZERO
  7575. SCTCLXM  EQU   24                      TOKEN LENGTH EXCEEDS MAXIMUM
  7576. SCTCUE   EQU   28                      TOKEN MISSING (UNEXPECTED END)
  7577. SCTCZBV  EQU   32                      ZERO BRANCH VALUE (A OR V)
  7578. SCTCSCD  EQU   36                      SOMETHING FOUND BY SCDONE
  7579. SCTCBXN  EQU   40                      BAD HEX NUMBER
  7580. SCTCBXS  EQU   44                      BAD HEX STRING
  7581. SCTCNQ   EQU   48                      REQUIRED QUOTES MISSING
  7582. SCTCNP   EQU   52                      REQUIRES PARENTHESES MISSING
  7583. SCTCBINT EQU   56                      BAD INTEGER
  7584. SCTCBORD EQU   60                      BAD ORDINAL
  7585. SCTCBLN  EQU   64                      BAD LINE NUMBER
  7586. *
  7587. SCTCMAX  EQU   SCTCBLN                 MAX CODE
  7588.          MEND
  7589. ./       ADD   LIST=ALL,NAME=SCTELL
  7590.          MACRO
  7591. &L       SCTELL &SCT=SCTSTART
  7592. &L       LM    VR0,VR1,SCTLEN-SCTSTART+&SCT
  7593.          MEND
  7594. ./       ADD   LIST=ALL,NAME=SCTYPE
  7595.          MACRO
  7596. &L       SCTYPE &NEW=,&OLD=,&SCT=SCTSTART
  7597. &L  SYSLST SCTTYPE-SCTSTART+&SCT,NEW=&NEW,OLD=&OLD,LOAD=LOADB,STORE=STC
  7598.          MEND
  7599. ./       ADD   LIST=ALL,NAME=SF
  7600.          MACRO
  7601. &L       SF
  7602.          LCLA  &X,&Y,&Z,&I
  7603.          LCLC  &F(16)
  7604. .*
  7605.          AIF   (N'&SYSLIST LT 1).NONE
  7606. .LOOP    ANOP
  7607. &X       SETA  &X+1
  7608.          AIF   (&X GT N'&SYSLIST).DONE
  7609. .*
  7610.          AIF   (&Z GE 16).MANY
  7611. .*
  7612. &F(&Z+1) SETC  '+L'''(1,3)
  7613. &F(&Z+2) SETC  '&SYSLIST(&X)'
  7614. &I       SETA  0
  7615. .SCAN    ANOP
  7616. &I       SETA  &I+1
  7617.          AIF   (&I GT K'&F(&Z+2)).SCANOK
  7618.          AIF   ('&F(&Z+2)'(&I,1) GE 'A').SCAN
  7619.          AIF   (&I LE 1).SCANOK
  7620. &F(&Z+2) SETC  '&F(&Z+2)'(1,&I-1)
  7621. .SCANOK  ANOP
  7622. .*
  7623. &Y       SETA  &Z+2
  7624. .CHECK   ANOP
  7625. &Y       SETA  &Y-2
  7626.          AIF   (&Y LT 2).UNIQUE
  7627.          AIF   ('&F(&Z+2)' NE '&F(&Y)').CHECK
  7628.          MNOTE 4,'"&F(&Z+2)" IS SPECIFIED MORE THAN ONCE'
  7629. &F(&Z+1) SETC  ''
  7630. &F(&Z+2) SETC  ''
  7631.          AGO   .LOOP
  7632. .*
  7633. .UNIQUE  ANOP
  7634.          AIF   (&X LE 1).NTEST
  7635.          OI    0,(&F(&Z+2)-&F(2))*256
  7636.          ORG   *-4
  7637. .NTEST   ANOP
  7638. &Z       SETA  &Z+2
  7639.          AGO   .LOOP
  7640. .*
  7641. .DONE    ANOP
  7642. &F(1)    SETC  'L'''(1,2)
  7643. &L       OI    &SYSLIST(1),&F(1)&F(2)&F(3)&F(4)&F(5)&F(6)&F(7)&F(8)&F(9*
  7644.                )&F(10)&F(11)&F(12)&F(13)&F(14)&F(15)&F(16)
  7645.          MEXIT
  7646. .*
  7647. .NONE    ANOP
  7648.          MNOTE 12,'NO FLAGS SPECIFIED'
  7649.          CLI   *+1,0
  7650.          MEXIT
  7651. .*
  7652. .MANY    ANOP
  7653.          MNOTE 12,'TOO MANY FLAGS SPECIFIED'
  7654.          AGO   .DONE
  7655.          MEND
  7656. ./       ADD   LIST=ALL,NAME=SI
  7657.          MACRO
  7658. &L       SI    &R,&V
  7659.          LCLA  &X
  7660.          AIF   ('&V' EQ '2').BCTR2
  7661.          AIF   ('&V' EQ '1').BCTR1
  7662. .LOOP    ANOP
  7663. &X       SETA  &X+1
  7664.          AIF   (&X GT K'&V).F
  7665.          AIF   ('&V'(&X,1) GE '0').LOOP
  7666.          AIF  (&X EQ 1 AND ('&V'(1,1) EQ '-' OR '&V'(1,1) EQ '+')).LOOP
  7667. &L       SL    &R,=A(&V)
  7668.          MEXIT
  7669. .F       ANOP
  7670. &L       SL    &R,=F'&V'
  7671.          MEXIT
  7672. .BCTR2   ANOP
  7673. &L       BCTR  &R,0
  7674.          BCTR  &R,0
  7675.          MEXIT
  7676. .BCTR1   ANOP
  7677. &L       BCTR  &R,0
  7678.          MEND
  7679. ./       ADD   LIST=ALL,NAME=SIM370
  7680.          MACRO
  7681. &L       SIM370 &WORDS,&CLEAR=
  7682.          GBLC  &SIM370
  7683.          SYSKWT CLEAR,&CLEAR,(YES,NO),COND=NO
  7684.          AIF   ('&CLEAR' EQ 'YES').CLEAR
  7685. &L       SYSLBL
  7686. &SIM370  SETC  '&WORDS'
  7687.          AIF   ('&WORDS' NE '').END
  7688. &SIM370  SETC  '*NO*370*'
  7689.          MEXIT
  7690. .*
  7691. .CLEAR   ANOP
  7692. &L       MZC   &WORDS,16
  7693. &SIM370  SETC  '&WORDS'
  7694. .END     MEND
  7695. ./       ADD   LIST=ALL,NAME=STOREB
  7696.          MACRO
  7697. &L       STOREB &R,&A
  7698. &L       STC   &R,&A
  7699.          MEND
  7700. ./       ADD   LIST=ALL,NAME=STOREF
  7701.          MACRO
  7702. &L       STOREF &R,&A
  7703.          GBLC  &CPU,&SIM370
  7704.          AIF   ('&CPU' EQ '360').S360
  7705. &L       UAOP  ST,&R,&A
  7706.          MEXIT
  7707. .S360    ANOP
  7708. &L       ST    &R,&SIM370
  7709.          SYSXXCB MVC,&A,&SIM370,4
  7710.          MEND
  7711. ./       ADD   LIST=ALL,NAME=STOREH
  7712.          MACRO
  7713. &L       STOREH &R,&A
  7714.          GBLC  &CPU,&SIM370
  7715.          AIF   ('&CPU' EQ '360').S360
  7716. &L       UAOP  STH,&R,&A
  7717.          MEXIT
  7718. .S360    ANOP
  7719. &L       ST    &R,&SIM370
  7720.          MMVC  &A,2+&SIM370,2
  7721.          MEND
  7722. ./       ADD   LIST=ALL,NAME=STORELF
  7723.          MACRO
  7724. &L       STORELF &R,&A
  7725. &L       STOREF &R,&A
  7726.          MEND
  7727. ./       ADD   LIST=ALL,NAME=STORELH
  7728.          MACRO
  7729. &L       STORELH &R,&A
  7730. &L       STOREH &R,&A
  7731.          MEND
  7732. ./       ADD   LIST=ALL,NAME=STOREP
  7733.          MACRO
  7734. &L       STOREP &R,&A
  7735.          GBLC  &CPU,&SIM370
  7736.          AIF   ('&CPU' EQ '360').S360
  7737. &L       STCM  &R,7,&A
  7738.          MEXIT
  7739. .S360    ANOP
  7740. &L       ST    &R,&SIM370
  7741.          MMVC  &A,1+&SIM370,3
  7742.          MEND
  7743. ./       ADD   LIST=ALL,NAME=STRIP
  7744.          MACRO
  7745. &L       STRIP &S,&N,&W,&TYPE=RIGHT,&ZERO=YES,&NULL=YES,&LABEL=,&FILL=0
  7746. &L       DEBLANK &S,&N,&W,TYPE=&TYPE,ZERO=&ZERO,NULL=&NULL,            *
  7747.                LABEL=&LABEL,FILL=&FILL
  7748.          MEND
  7749. ./       ADD   LIST=ALL,NAME=SUBB
  7750.          MACRO
  7751. &L       SUBB  &R,&A
  7752.          GBLC  &SIM370
  7753. &L       MMVC  4*3+3+&SIM370,&A,1
  7754.          SL    &R,4*3+&SIM370
  7755.          MEND
  7756. ./       ADD   LIST=ALL,NAME=SUBF
  7757.          MACRO
  7758. &L       SUBF  &R,&A
  7759.          GBLC  &CPU,&SIM370
  7760.          AIF   ('&CPU' EQ '360').S360
  7761. &L       UAOP  S,&R,&A
  7762.          MEXIT
  7763. .S360    ANOP
  7764. &L       MMVC  &SIM370,&A,4
  7765.          S     &R,&SIM370
  7766.          MEND
  7767. ./       ADD   LIST=ALL,NAME=SUBH
  7768.          MACRO
  7769. &L       SUBH  &R,&A
  7770.          GBLC  &CPU,&SIM370
  7771.          AIF   ('&CPU' EQ '360').S360
  7772. &L       UAOP  SH,&R,&A
  7773.          MEXIT
  7774. .S360    ANOP
  7775. &L       MMVC  &SIM370,&A,2
  7776.          SH    &R,&SIM370
  7777.          MEND
  7778. ./       ADD   LIST=ALL,NAME=SUBLF
  7779.          MACRO
  7780. &L       SUBLF &R,&A
  7781.          GBLC  &CPU,&SIM370
  7782.          AIF   ('&CPU' EQ '360').S360
  7783. &L       UAOP  SL,&R,&A
  7784.          MEXIT
  7785. .S360    ANOP
  7786. &L       MMVC  &SIM370,&A,4
  7787.          SL    &R,&SIM370
  7788.          MEND
  7789. ./       ADD   LIST=ALL,NAME=SUBLH
  7790.          MACRO
  7791. &L       SUBLH &R,&A
  7792.          GBLC  &SIM370
  7793. &L       MMVC  4*2+2+&SIM370,&A,2
  7794.          SL    &R,4*2+&SIM370
  7795.          MEND
  7796. ./       ADD   LIST=ALL,NAME=SUBP
  7797.          MACRO
  7798. &L       SUBP  &R,&A
  7799.          GBLC  &SIM370
  7800. &L       MMVC  4*1+1+&SIM370,&A,3
  7801.          SL    &R,4*1+&SIM370
  7802.          MEND
  7803. ./       ADD   LIST=ALL,NAME=SUBTITLE
  7804.          MACRO
  7805. &L       SUBTITLE &T
  7806. &L       SYSLBL
  7807.          TITLE &T
  7808.          MEND
  7809. ./       ADD   LIST=ALL,NAME=SYSBIT
  7810.          MACRO
  7811. &L       SYSBIT &A,&B,&SET=,&RESET=
  7812.          SYSKWT SET,&SET,(YES,NO,ONLY),COND=NO
  7813.          SYSKWT RESET,&RESET,(YES,NO,ONLY),COND=NO
  7814.          AIF   ('&SET' EQ '' OR '&RESET' EQ '').OK
  7815.          AIF   ('&SET' EQ 'NO' OR '&RESET' EQ 'NO').OK
  7816.          MNOTE 12,'CANNOT SPECIFY BOTH SET AND RESET'
  7817. .OK      ANOP
  7818.          AIF   ('&RESET' NE '' AND '&RESET' NE 'NO').RESET
  7819. .*
  7820. .*  SET
  7821. .*
  7822.          AIF   ('&SET' EQ 'ONLY').SONLY
  7823. &L       TM    &A,&B
  7824.          AIF   ('&SET' NE 'YES').END
  7825.          BO    *+12
  7826.          OI    &A,&B
  7827.          CLI   *+1,0
  7828.          MEXIT
  7829. .SONLY   ANOP
  7830. &L       OI    &A,&B
  7831.          MEXIT
  7832. .*
  7833. .*  RESET
  7834. .*
  7835. .RESET   ANOP
  7836.          AIF   ('&RESET' EQ 'ONLY').RONLY
  7837. &L       TM    &A,&B
  7838.          BZ    *+12
  7839.          NI    &A,255-(&B)
  7840.          TM    *+1,255
  7841.          MEXIT
  7842. .RONLY   ANOP
  7843. &L       NI    &A,255-(&B)
  7844. .END     MEND
  7845. ./       ADD   LIST=ALL,NAME=SYSCMP
  7846.          MACRO
  7847. &L       SYSCMP &A,&R,&B,&MSG=
  7848. &L       SYSLBL
  7849.          AIF   ('&MSG' EQ '').STD
  7850.          MNOTE *,&MSG
  7851.          AGO   .COM
  7852. .STD     ANOP
  7853.          MNOTE *,'ERROR BELOW IF &A NOT &R &B'
  7854. .COM     ANOP
  7855. .*
  7856. .*  BRANCH ON RELATION
  7857. .*
  7858.          AIF   ('&R' EQ 'LT').LT
  7859.          AIF   ('&R' EQ 'NGE').LT
  7860.          AIF   ('&R' EQ 'LE').LE
  7861.          AIF   ('&R' EQ 'NGT').LE
  7862.          AIF   ('&R' EQ 'EQ').EQ
  7863.          AIF   ('&R' EQ 'GE').GE
  7864.          AIF   ('&R' EQ 'NLT').GE
  7865.          AIF   ('&R' EQ 'GT').GT
  7866.          AIF   ('&R' EQ 'NLE').GT
  7867.          AIF   ('&R' EQ 'NEQ' OR '&R' EQ 'NE').NEQ
  7868.          MNOTE 12,'"&R" IS AN ILLEGAL RELATION'
  7869.          MEXIT
  7870. .*
  7871. .LT      DS    0CL(&B-(&A))
  7872.          MEXIT
  7873. .*
  7874. .LE      DS    0CL(&B+1-(&A))
  7875.          MEXIT
  7876. .*
  7877. .EQ      DS    0CL(&B+1-(&A)),0CL(&A+1-(&B))
  7878.          MEXIT
  7879. .*
  7880. .GE      DS    0CL(&A+1-(&B))
  7881.          MEXIT
  7882. .*
  7883. .GT      DS    0CL(&A-(&B))
  7884.          MEXIT
  7885. .*
  7886. .NEQ     DS    0CL(2-((&A)/(&B))/((&A)/(&B))-((&B)/(&A))/((&B)/(&A)))
  7887.          MEND
  7888. ./       ADD   LIST=ALL,NAME=SYSKWT
  7889.          MACRO
  7890. &L       SYSKWT &NAME,&KWS,&LEGAL,&COND=,&NULL=
  7891.          LCLA  &X
  7892.          AIF   ('&KWS' EQ '' AND '&NULL' NE '').ERROR
  7893.          AIF   ('&KWS' EQ '').END
  7894.          AIF   ('&COND' EQ '').COND
  7895.          AIF   ('&COND' EQ 'YES').COND
  7896.          AIF   ('&COND'(1,1) EQ '(').CONDL
  7897.          AIF   ('&KWS'(1,1) EQ '(').ERROR
  7898.          AGO   .COND
  7899. .CONDL   AIF   ('&KWS'(1,1) NE '(').COND
  7900. &X       SETA  1
  7901. .LOOPL   AIF   (&X GT N'&COND).ERROR
  7902.          AIF   ('&KWS(1)' EQ '&COND(&X)').COND
  7903. &X       SETA  &X+1
  7904.          AGO   .LOOPL
  7905. .COND    ANOP
  7906. &X       SETA  1
  7907. .LOOP    AIF   (&X GT N'&LEGAL).ERROR
  7908.          AIF   ('&KWS(1)' EQ '&LEGAL(&X)').END
  7909. &X       SETA  &X+1
  7910.          AGO   .LOOP
  7911. .ERROR   AIF   ('&NAME' EQ '').POSERR
  7912.          MNOTE 12,'"&NAME=&KWS" IS ILLEGAL'
  7913.          MEXIT
  7914. .POSERR  MNOTE 12,'"&KWS" IS ILLEGAL'
  7915. .END     MEND
  7916. ./       ADD   LIST=ALL,NAME=SYSLBL
  7917.          MACRO
  7918. &L       SYSLBL &TYPE=H
  7919.          AIF   ('&L' EQ '').END
  7920. &L       DS    0&TYPE
  7921. .END     MEND
  7922. ./       ADD   LIST=ALL,NAME=SYSLR
  7923.          MACRO
  7924. &L      SYSLR &R,&P,&TYPE=,&SELECT=,&NULL=0,&ERR=,&OP=LA,<R=,&STRLEN=
  7925.          LCLA  &X,&PT,&KC(32)
  7926.          LCLB  &LCR
  7927.          LCLC  &C(32),&LABEL,&OPC
  7928. .*
  7929. .*  CHECK FOR LITERAL STRING
  7930. .*
  7931.          AIF   ('&P' EQ '').NSTRING
  7932.          AIF   ('&P'(1,1) NE '''' OR '&STRLEN' EQ '').NSTRING
  7933. &L       SYSLR &R,=CL&STRLEN&P,TYPE=&TYPE,SELECT=&SELECT,NULL=&NULL,   *
  7934.                ERR=&ERR,OP=&OP,LTR=<R
  7935.          MEXIT
  7936. .*
  7937. .NSTRING ANOP
  7938. .*
  7939. .*  CHECK FOR COMPLEMENT CONDITIONS
  7940. .*
  7941.          AIF   ('&TYPE' EQ '').GO
  7942. &LCR     SETB  1
  7943.          AIF   ('&SELECT' EQ '').GO
  7944. &X       SETA  1
  7945. .LOUP    AIF   (&X GT N'&SELECT).LOUPEND
  7946.          AIF   ('&TYPE(1)' EQ '&SELECT(&X)').GO
  7947. &X       SETA  &X+1
  7948.          AGO   .LOUP
  7949. .LOUPEND ANOP
  7950. &LCR     SETB  0
  7951. .GO      ANOP
  7952. .*
  7953. .*  CHECK FOR AND HANDLE OMITTED OPERAND
  7954. .*
  7955.          AIF   ('&P' NE '').NBL
  7956.          AIF   ('&ERR' EQ '').NERR
  7957.          MNOTE 12,&ERR
  7958. .NERR    AIF   ('&NULL' EQ '').LBL
  7959.          AIF   ('&NULL' EQ '0').SR
  7960. &L       SYSLR &R,&NULL,NULL=,OP=&OP,TYPE=&TYPE,SELECT=&SELECT,LTR=<R
  7961.          MEXIT
  7962. .LBL     ANOP
  7963.          AIF   ('<R' NE '').LBLLTR
  7964. &L       SYSLBL
  7965.          MEXIT
  7966. .LBLLTR  ANOP
  7967. &L       LTR   &R,&R
  7968.          MEXIT
  7969. .*
  7970. .*  CHECK FOR REGISTER OR ZERO
  7971. .*
  7972. .NBL     AIF   ('&P'(1,1) EQ '(').REG
  7973.          AIF   ('&P' EQ '0').SR
  7974. .*
  7975. .*  ISOLATE OPCODE AND PROCESS
  7976. .*
  7977. &LABEL   SETC  '&L'
  7978. &OPC     SETC  '&OP'
  7979.          AIF   (K'&P LE 2).EXPR
  7980.          AIF   ('&P'(1,2) EQ 'L:').L
  7981.          AIF   (K'&P LE 3).EXPR
  7982.          AIF   ('&P'(1,3) EQ 'LA:').LX
  7983.          AIF   ('&P'(1,3) EQ 'LH:').LX
  7984.          AIF   ('&P'(1,3) EQ 'IC:').IC
  7985.          AIF   (K'&P LE 6).EXPR
  7986.          AIF   ('&P'(1,6) EQ 'LOADB:').LOADX
  7987.          AIF   ('&P'(1,6) EQ 'LOADH:').LOADX
  7988.          AIF   ('&P'(1,6) EQ 'LOADP:').LOADX
  7989.          AIF   ('&P'(1,6) EQ 'LOADF:').LOADX
  7990.          AIF   (K'&P LE 7).EXPR
  7991.          AIF   ('&P'(1,7) EQ 'LOADLH:').LOADXX
  7992.          AIF   ('&P'(1,7) EQ 'LOADLF:').LOADXX
  7993.          AGO   .EXPR
  7994. .LOADX   ANOP
  7995. &PT      SETA  6
  7996.          AGO   .DO
  7997. .LOADXX  ANOP
  7998. &PT      SETA  7
  7999.          AGO   .DO
  8000. .IC      ANOP
  8001. &L       SLR   &R,&R
  8002. &LABEL   SETC  ''
  8003. .LX      ANOP
  8004. &PT      SETA  3
  8005.          AGO   .DO
  8006. .L       ANOP
  8007. &PT      SETA  2
  8008. .DO      ANOP
  8009. &OPC     SETC  '&P'(1,&PT-1)
  8010. .EXPR    ANOP
  8011. &X       SETA  1
  8012. .LOOP    AIF   (K'&P-&PT LE &X*8).BIT
  8013. &KC(&X)  SETA  8
  8014. &C(&X)   SETC  '&P'(&PT+(&X-1)*8+1,8)
  8015. &X       SETA  &X+1
  8016.          AGO   .LOOP
  8017. .BIT     ANOP
  8018. &KC(&X)  SETA  K'&P-&PT-(&X-1)*8
  8019. &C(&X)   SETC  '&P'(&PT+(&X-1)*8+1,&KC(&X))
  8020.          AIF   ('&C(1)'(1,1) NE ':').NLIT
  8021. &C(1)    SETC  '='.'&C(1)'(2,&KC(1)-1)
  8022. .NLIT    ANOP
  8023.          AIF   ('&OPC' EQ 'LOADB').LOADB
  8024.          AIF   ('&OPC' EQ 'LOADH').LOADH
  8025.          AIF   ('&OPC' EQ 'LOADLH').LOADLH
  8026.          AIF   ('&OPC' EQ 'LOADP').LOADP
  8027.          AIF   ('&OPC' EQ 'LOADF').LOADF
  8028.          AIF   ('&OPC' EQ 'LOADLF').LOADLF
  8029.          AIF   ('&OPC' EQ 'LITA').LITA
  8030.          AIF   ('&OPC' EQ 'LITF').LITF
  8031.          AIF   ('&OPC' EQ 'LITH').LITH
  8032.          AIF   ('&OPC' EQ 'LITY').LITY
  8033. &LABEL  SYSLROP &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8034.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8035.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8036.                )&C(30)&C(31)&C(32),OP=&OPC
  8037. .COM     AIF   (NOT &LCR).COMLTR
  8038.          SYSTANDB &TYPE,2,LCR,&R,&R
  8039.          AIF   ('&TYPE'(1,1) NE '(').END
  8040. .COMLTR  ANOP
  8041.          AIF   ('<R' EQ '').END
  8042.          LTR   &R,&R
  8043.          MEXIT
  8044. .LOADB   ANOP
  8045. &LABEL   LOADB  &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8046.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8047.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8048.                )&C(30)&C(31)&C(32)
  8049.          AGO   .COM
  8050. .LOADH   ANOP
  8051. &LABEL   LOADH  &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8052.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8053.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8054.                )&C(30)&C(31)&C(32)
  8055.          AGO   .COM
  8056. .LOADLH  ANOP
  8057. &LABEL   LOADLH &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8058.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8059.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8060.                )&C(30)&C(31)&C(32)
  8061.          AGO   .COM
  8062. .LOADP   ANOP
  8063. &LABEL   LOADP  &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8064.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8065.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8066.                )&C(30)&C(31)&C(32)
  8067.          AGO   .COM
  8068. .LOADF   ANOP
  8069. &LABEL   LOADF  &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8070.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8071.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8072.                )&C(30)&C(31)&C(32)
  8073.          AGO   .COM
  8074. .LOADLF  ANOP
  8075. &LABEL   LOADLF &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8076.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8077.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8078.                )&C(30)&C(31)&C(32)
  8079.          AGO   .COM
  8080. .LITA    ANOP
  8081. &LABEL   L     &R,=A(&P)
  8082.          AGO   .COM
  8083. .LITF    ANOP
  8084. &LABEL   L     &R,=F'&P'
  8085.          AGO   .COM
  8086. .LITH    ANOP
  8087. &LABEL   LH    &R,=H'&P'
  8088.          AGO   .COM
  8089. .LITY    ANOP
  8090. &LABEL   LH    &R,=AL2(&P)
  8091.          AGO   .COM
  8092. .*
  8093. .*  HANDLE ZERO
  8094. .*
  8095. .SR      ANOP
  8096. &L       SLR   &R,&R
  8097.          MEXIT
  8098. .*
  8099. .*  HANDLE REGISTER
  8100. .*
  8101. .REG     AIF   (&LCR).LCR
  8102.          AIF   ('(&R)' EQ '&P').LBL
  8103.          AIF   ('<R' NE '').LTR
  8104. &L       LR    &R,&P
  8105.          MEXIT
  8106. .LTR     ANOP
  8107. &L       LTR   &R,&P
  8108.          MEXIT
  8109. .LCR     ANOP
  8110.          AIF   ('&TYPE'(1,1) EQ '(').LCRX
  8111. &L       LCR   &R,&P
  8112.          MEXIT
  8113. .LCRX    ANOP
  8114. &L       LR    &R,&P
  8115.          SYSTANDB &TYPE,2,LCR,&R,&R
  8116.          AIF   ('<R' EQ '').END
  8117.          LTR   &R,&R
  8118. .END     MEND
  8119. ./       ADD   LIST=ALL,NAME=SYSLROP
  8120.          MACRO
  8121. &L       SYSLROP &R,&A,&OP=
  8122. &L       &OP   &R,&A
  8123.          MEND
  8124. ./       ADD   LIST=ALL,NAME=SYSLST
  8125.          MACRO
  8126. &L       SYSLST &LOC,&NEW=,&OLD=,&LOAD=L,&STORE=ST,&OP=LA,®=RTNR
  8127.          AIF   ('&NEW' EQ '').NNEW
  8128.          AIF   ('&OLD' EQ '').NEWNOLD
  8129.          AIF   ('&NEW'(1,1) EQ '(' AND '&NEW' NE '(&OLD)').RNEWOLD
  8130.          AIF   (('&STORE' NE 'STC' AND '&STORE' NE 'STOREB')           *
  8131.                OR '&OP' NE 'LA').NMVI
  8132.          AIF   ('&NEW'(1,1) EQ '(').NMVI
  8133.          AIF   (K'&NEW LE 2).MVI
  8134.          AIF   ('&NEW'(1,2) EQ 'L:').NMVI
  8135.          AIF   (K'&NEW LE 3).MVI
  8136.          AIF   ('&NEW'(1,3) EQ 'LA:').NMVI
  8137.          AIF   ('&NEW'(1,3) EQ 'LH:').NMVI
  8138.          AIF   ('&NEW'(1,3) EQ 'IC:').NMVI
  8139.          AIF   (K'&NEW LE 6).MVI
  8140.          AIF   ('&NEW'(1,6) EQ 'LOADB:').NMVI
  8141.          AIF   ('&NEW'(1,6) EQ 'LOADH:').NMVI
  8142.          AIF   ('&NEW'(1,6) EQ 'LOADP:').NMVI
  8143.          AIF   ('&NEW'(1,6) EQ 'LOADF:').NMVI
  8144.          AIF   (K'&NEW LE 7).MVI
  8145.          AIF   ('&NEW'(1,7) EQ 'LOADLH:').NMVI
  8146.          AIF   ('&NEW'(1,7) EQ 'LOADLF:').NMVI
  8147.          AGO   .MVI
  8148. .NMVI    ANOP
  8149. &L       SYSLR ®,&NEW,OP=&OP
  8150.          SYSLR &OLD,&LOC,OP=&LOAD
  8151.          SYSLSTS &STORE,®,&LOC
  8152.          MEXIT
  8153. .*
  8154. .MVI     ANOP
  8155. &L       SYSLR &OLD,&LOC,OP=&LOAD
  8156.          MVI   &LOC,&NEW
  8157.          MEXIT
  8158. .*
  8159. .RNEWOLD ANOP
  8160. &L       SYSLR &OLD,&LOC,OP=&LOAD
  8161.          SYSLSTS &STORE,&NEW,&LOC
  8162.          MEXIT
  8163. .*
  8164. .NEWNOLD ANOP
  8165.          AIF   ('&NEW'(1,1) EQ '(').RNEWNOL
  8166.          AIF   (('&STORE' NE 'STC' AND '&STORE' NE 'STOREB')           *
  8167.                OR '&OP' NE 'LA').NMVINOL
  8168.          AIF   ('&NEW'(1,1) EQ '(').NMVINOL
  8169.          AIF   (K'&NEW LE 2).MVINOLD
  8170.          AIF   ('&NEW'(1,2) EQ 'L:').NMVINOL
  8171.          AIF   (K'&NEW LE 3).MVINOLD
  8172.          AIF   ('&NEW'(1,3) EQ 'LA:').NMVINOL
  8173.          AIF   ('&NEW'(1,3) EQ 'LH:').NMVINOL
  8174.          AIF   ('&NEW'(1,3) EQ 'IC:').NMVINOL
  8175.          AIF   (K'&NEW LE 6).MVINOLD
  8176.          AIF   ('&NEW'(1,6) EQ 'LOADB:').NMVINOL
  8177.          AIF   ('&NEW'(1,6) EQ 'LOADH:').NMVINOL
  8178.          AIF   ('&NEW'(1,6) EQ 'LOADP:').NMVINOL
  8179.          AIF   ('&NEW'(1,6) EQ 'LOADF:').NMVINOL
  8180.          AIF   (K'&NEW LE 7).MVINOLD
  8181.          AIF   ('&NEW'(1,7) EQ 'LOADLH:').NMVINOL
  8182.          AIF   ('&NEW'(1,7) EQ 'LOADLF:').NMVINOL
  8183.          AGO   .MVINOLD
  8184. .NMVINOL ANOP
  8185. &L       SYSLR ®,&NEW,OP=&OP
  8186.          SYSLSTS &STORE,®,&LOC
  8187.          MEXIT
  8188. .*
  8189. .MVINOLD ANOP
  8190. &L       MVI   &LOC,&NEW
  8191.          MEXIT
  8192. .*
  8193. .RNEWNOL ANOP
  8194. &L       SYSLSTS &STORE,&NEW,&LOC
  8195.          MEXIT
  8196. .*
  8197. .NNEW    ANOP
  8198.          AIF   ('&OLD' EQ '').ERROR
  8199. &L       SYSLR &OLD,&LOC,OP=&LOAD
  8200.          MEXIT
  8201. .*
  8202. .ERROR   ANOP
  8203.          MNOTE 12,'EITHER NEW OR OLD (OR BOTH) MUST BE SPECIFIED'
  8204.          MEND
  8205. ./       ADD   LIST=ALL,NAME=SYSLSTS
  8206. ALP;
  8207.  
  8208. MACRO &&L: SYSLSTS &&OP,&&R,&&A;
  8209.    ASM CASE '&OP';
  8210.       'STOREB': <&&L: STOREB &&R,&&A>;
  8211.       'STOREH','STORELH': <&&L: STOREH &&R,&&A>;
  8212.       'STOREP': <&&L: STOREP &&R,&&A>;
  8213.       'STOREF','STORELF': <&&L: STOREF &&R,&&A>;
  8214.       ENDCASE
  8215.    ELSE BEGIN
  8216.       BAL;
  8217. &L &OP &R,&A
  8218. ALP;
  8219.       END;
  8220.    MEND;
  8221. BAL;
  8222. ./       ADD   LIST=ALL,NAME=SYSLV
  8223.          MACRO
  8224. &L       SYSLV
  8225.          LCLA  &X,&Y,&V
  8226.          LCLB  &SW(97)
  8227. .*
  8228. .*  COMPUTE INITIAL VALUE FOR REGISTER
  8229. .*
  8230. &X       SETA  2-3
  8231. .VLOOP   ANOP
  8232. &X       SETA  &X+3
  8233.          AIF   (&X GT N'&SYSLIST).VDONE
  8234.          AIF   ('&SYSLIST(&X+1)' EQ '').VLOOP
  8235.          AIF   ('&SYSLIST(&X+2)' EQ '').VADD
  8236. &Y       SETA  1
  8237. .SLOOP   ANOP
  8238.          AIF   ('&SYSLIST(&X+1,1)' EQ '&SYSLIST(&X+2,&Y)').VADD
  8239. &Y       SETA  &Y+1
  8240.          AIF   (&Y LE N'&SYSLIST(&X+2)).SLOOP
  8241.          AGO   .VLOOP
  8242. .VADD    ANOP
  8243. &SW(&X)  SETB  1
  8244.          AIF   ('&SYSLIST(&X+1)'(1,1) EQ '(').VLOOP
  8245. &V       SETA  &V+&SYSLIST(&X+0)
  8246.          AGO   .VLOOP
  8247. .VDONE   ANOP
  8248.          AIF   (&V LT 4096).LA
  8249. &L       L     &SYSLIST(1),=F'&V'
  8250.          AGO   .DOTEST
  8251. .*
  8252. .LA      ANOP
  8253. &L       SYSLR &SYSLIST(1),&V
  8254. .*
  8255. .*  SEARCH FOR TEST REQUESTS
  8256. .*
  8257. .DOTEST  ANOP
  8258. &X       SETA  2-3
  8259. .TLOOP   ANOP
  8260. &X       SETA  &X+3
  8261.          AIF   (&X GT N'&SYSLIST).TDONE
  8262.          AIF   (NOT &SW(&X)).TLOOP
  8263.          AIF   ('&SYSLIST(&X+1)'(1,1) NE '(').TLOOP
  8264.          AIF   ('&SYSLIST(1)' EQ 'VR0').VR0
  8265.     SYSTANDB &SYSLIST(&X+1),4,LA,&SYSLIST(1),&SYSLIST(&X)(,&SYSLIST(1))
  8266.          AGO   .TLOOP
  8267. .*
  8268. .VR0     SYSTANDB &SYSLIST(&X+1),4,A,VR0,=F'&SYSLIST(&X)'
  8269.          AGO   .TLOOP
  8270. .*
  8271. .TDONE   ANOP
  8272.          MEND
  8273. ./       ADD   LIST=ALL,NAME=SYSPRED
  8274. ALP;
  8275.  
  8276. MACRO &&L: SYSPRED &&LBL,&&IF=,&&BRANCH=TRUE;
  8277.    LCLA &&X;
  8278.    LCLC &&LBLEND;
  8279.  
  8280.    SYSKWT BRANCH,&&BRANCH,(TRUE,FALSE),COND=NO,NULL=NO;
  8281.  
  8282.    &&L: SYSLBL;
  8283.    ASM FOR &&X FROM 1 BY 5 TO N'&&IF DO BEGIN
  8284.       ASM CASE '&IF(&X)';  % GENERATE INSTRUCTION
  8285.          'TF': BEGIN
  8286.             ASM IF ('&IF(&X+2)' EQ '')
  8287.             THEN TF &&IF(&&X+1)
  8288.             ELSE TF &&IF(&&X+1),&&IF(&&X+2);
  8289.             END;
  8290.          '': BEGIN
  8291.             ASM IF ('&IF(&X+1)&IF(&X+2)' NE '')
  8292.             THEN MNOTE 12,'NULL OPCODE MUST HAVE NULL OPERANDS';
  8293.             END;
  8294.          ENDCASE
  8295.       ELSE BEGIN
  8296.          BAL;
  8297.          &IF(&X) &IF(&X+1),&IF(&X+2)
  8298.          ALP;
  8299.          END;
  8300.       ASM CASE '&BRANCH';
  8301.          'TRUE','': BEGIN
  8302.             ASM CASE '&IF(&X+4)';
  8303.                'OR': BEGIN
  8304.                   SYSPREDB &&IF(&&X+3),&&LBL;  % BR IF TRUE
  8305.                   END;
  8306.                '': BEGIN
  8307.                   ASM IF (&&X+5 LT N'&&IF)
  8308.                   THEN MNOTE 12,'"" IS AN ILLEGAL OPERATOR';
  8309.                   SYSPREDB &&IF(&&X+3),&&LBL;  % BR IF TRUE
  8310.                   END;
  8311.                'AND': BEGIN
  8312.                   &&LBLEND: SETC 'PRED&@';
  8313.                   SYSPREDB N&&IF(&&X+3),&&LBLEND;  % BR IF FALSE
  8314.                   END;
  8315.                ENDCASE
  8316.             ELSE BEGIN
  8317.                MNOTE 12,'"&IF(&X+4)" IS AN ILLEGAL OPERATOR';
  8318.                SYSPREDB &&IF(&&X+3),&&LBL;  % BR IF TRUE
  8319.                END;
  8320.             END;
  8321.          'FALSE': BEGIN
  8322.             ASM CASE '&IF(&X+4)';
  8323.                'OR': BEGIN
  8324.                   &&LBLEND: SETC 'PRED&@';
  8325.                   SYSPREDB &&IF(&&X+3),&&LBLEND;
  8326.                   END;
  8327.                'AND': BEGIN
  8328.                   SYSPREDB N&&IF(&&X+3),&&LBL;
  8329.                   END;
  8330.                '': BEGIN
  8331.                   ASM IF (&&X+5 LT N'&&IF)
  8332.                   THEN MNOTE 12,'"" IS AN ILLEGAL OPERATOR';
  8333.                   SYSPREDB N&&IF(&&X+3),&&LBL;
  8334.                   END;
  8335.                ENDCASE
  8336.             ELSE BEGIN
  8337.                MNOTE 12,'"&IF(&X+4)" IS AN ILLEGAL OPERATOR';
  8338.                SYSPREDB N&&IF(&&X+3),&&LBL;  % BR IF FALSE
  8339.                END;
  8340.             END;
  8341.          ENDCASE ELSE;
  8342.       END;
  8343.    &&LBLEND: SYSLBL;
  8344.    MEND;
  8345.  
  8346. BAL;
  8347. ./       ADD   LIST=ALL,NAME=SYSPREDB
  8348. ALP;
  8349.  
  8350. MACRO &&L: SYSPREDB &&CC,&&LBL;
  8351.    LCLC &&C;
  8352.  
  8353.    &&C: SETC '&CC';
  8354.    ASM IF (K'&&CC GE 2) THEN ASM IF ('&CC'(1,2) EQ 'NN')
  8355.    THEN <&&C: SETC '&CC'(3,K'&&CC-2)>;
  8356.    BAL;
  8357. &L B&C &LBL
  8358.    ALP;
  8359.    MEND;
  8360.  
  8361. BAL;
  8362. ./       ADD   LIST=ALL,NAME=SYSQS
  8363.          MACRO
  8364. &L     SYSQS &AR,&LR,&AP,&LP,&NULL=,&TYPEA=,&TYPEL=,&SELECTA=,&SELECTL=
  8365.          LCLA  &X,&N
  8366.          LCLC  &C
  8367.          AIF   ('&AP' EQ '').NSTR
  8368.          AIF   ('&AP'(1,1) EQ '''').STR
  8369. .NSTR    ANOP
  8370.          AIF   ('&AP&LP' EQ '').NULL
  8371. &L       SYSLR &AR,&AP,TYPE=&TYPEA,SELECT=&SELECTA,                    *
  8372.                ERR='STRING LOCATION MISSING'
  8373.          SYSLR &LR,&LP,TYPE=&TYPEL,SELECT=&SELECTL,                    *
  8374.                ERR='STRING LENGTH MISSING'
  8375.          MEXIT
  8376. .*
  8377. .*  PROCESS OMITTED OPERANDS
  8378. .*
  8379. .NULL    ANOP
  8380.          AIF   ('&NULL(1)&NULL(2)' EQ '').NULLNUL
  8381. &L       SYSQS &AR,&LR,&NULL(1),&NULL(2),TYPEA=&TYPEA,TYPEL=&TYPEL,    *
  8382.                SELECTA=&SELECTA,SELECTL=&SELECTL
  8383.          MEXIT
  8384. .*
  8385. .NULLNUL ANOP
  8386. &L       SYSQS &AR,&LR,0,0
  8387.          MNOTE 12,'STRING MISSING'
  8388.          MEXIT
  8389. .*
  8390. .*  PROCESS QUOTED STRING
  8391. .*
  8392. .STR     AIF   ('&LP' NE '').LG
  8393. &L       SYSLR &AR,=C&AP,TYPE=&TYPEA,SELECT=&SELECTA
  8394. &X       SETA  1
  8395. &C       SETC  '&&'
  8396. .LOOP    ANOP
  8397. &X       SETA  &X+1
  8398.          AIF   (&X GE K'&AP).EL
  8399. &N       SETA  &N+1
  8400.          AIF   ('&AP'(&X,1) NE '''' AND '&AP'(&X,1) NE '&C'(1,1)).LOOP
  8401. &X       SETA  &X+1
  8402.          AGO   .LOOP
  8403. .EL      SYSLR &LR,&N,TYPE=&TYPEL,SELECT=&SELECTL
  8404.          MEXIT
  8405. .*
  8406. .*  PROCESS STRING WITH LENGTH GIVEN
  8407. .*
  8408. .LG      ANOP
  8409. &L       SYSLR &AR,=CL(&LP)&AP,TYPE=&TYPEA,SELECT=&SELECTA
  8410.          SYSLR &LR,&LP,TYPE=&TYPEL,SELECT=&SELECTL
  8411. .END     MEND
  8412. ./       ADD   LIST=ALL,NAME=SYSRNG
  8413.          MACRO
  8414.          SYSRNG &NAME,&VAL,&REL,&LIM
  8415.          LCLA  &X
  8416.          SYSKWT SYSRNG-RELATION,&REL,                                  *
  8417.                (LT,NLT,LE,NLE,EQ,NE,NEQ,GE,NGE,GT,NGT,MULT),           *
  8418.                NULL=NO,COND=NO
  8419. .*
  8420. &X       SETA  0
  8421. .TEST    ANOP
  8422. &X       SETA  &X+1
  8423.          AIF   (&X GT K'&VAL).NUM
  8424.          AIF   ('&VAL'(&X,1) GE '0' AND '&VAL'(&X,1) LE '9').TEST
  8425.          MNOTE 12,'"&NAME=&VAL" IS ILLEGAL, MUST BE ALL NUMERIC'
  8426.          MEXIT
  8427. .*
  8428. .NUM     ANOP
  8429. .*
  8430. &X       SETA  0
  8431. .LTEST   ANOP
  8432. &X       SETA  &X+1
  8433.          AIF   (&X GT K'&LIM).LNUM
  8434.          AIF   ('&LIM'(&X,1) GE '0' AND '&LIM'(&X,1) LE '9').LTEST
  8435.          MNOTE 12,'"SYSRNG-LIMIT=&LIM" IS ILLEGAL, MUST BE ALL NUMERIC'
  8436.          AGO   .OK
  8437. .*
  8438. .LNUM    ANOP
  8439. .*
  8440.          AIF   ('&REL' EQ 'LT' AND &VAL LT &LIM).OK
  8441.          AIF   ('&REL' EQ 'LE' AND &VAL LE &LIM).OK
  8442.          AIF   ('&REL' EQ 'EQ' AND &VAL EQ &LIM).OK
  8443.          AIF   ('&REL' EQ 'GE' AND &VAL GE &LIM).OK
  8444.          AIF   ('&REL' EQ 'GT' AND &VAL GT &LIM).OK
  8445.          AIF   ('&REL' EQ 'NLT' AND &VAL GE &LIM).OK
  8446.          AIF   ('&REL' EQ 'NLE' AND &VAL GT &LIM).OK
  8447.          AIF   ('&REL' EQ 'NEQ' AND &VAL NE &LIM).OK
  8448.          AIF   ('&REL' EQ 'NE' AND &VAL NE &LIM).OK
  8449.          AIF   ('&REL' EQ 'NGE' AND &VAL LT &LIM).OK
  8450.          AIF   ('&REL' EQ 'NGT' AND &VAL LE &LIM).OK
  8451.          AIF   ('&REL' EQ 'MULT').MULT
  8452.          MNOTE 12,'"&NAME=&VAL" IS ILLEGAL, MUST BE &REL &LIM'
  8453. .*
  8454. .OK      ANOP
  8455. &X       SETA  5
  8456. .LOOP    ANOP
  8457.          AIF   (&X GT N'&SYSLIST).END
  8458.          SYSRNG &NAME,&VAL,&SYSLIST(&X),&SYSLIST(&X+1)
  8459. &X       SETA  &X+2
  8460.          AGO   .LOOP
  8461. .*
  8462. .MULT    ANOP
  8463.          AIF   (&VAL EQ &VAL/&LIM*&LIM).OK
  8464.          MNOTE 12,'"&NAME=&VAL" IS ILLEGAL, MUST BE A MULTIPLE OF &LIM'
  8465.          AGO   .OK
  8466. .END     MEND
  8467. ./       ADD   LIST=ALL,NAME=SYSTANDB
  8468.          MACRO
  8469. &L       SYSTANDB &T,&C,&OP,&A,&B,&BC=N
  8470.          LCLC  &CC
  8471.          LCLA  &K
  8472.          AIF   ('&T' EQ '').END
  8473.          AIF   ('&T'(1,1) NE '(').OP
  8474.          AIF   ('&T(2)' EQ 'LT').LT
  8475.          AIF   ('&T(2)' EQ 'TF').TF
  8476.          AIF   ('&T(4)' EQ '').TEST1
  8477. &L       &T(2) &T(3),&T(4)
  8478.          AGO   .DOB
  8479. .*
  8480. .TEST1   ANOP
  8481. &L       &T(2) &T(3)
  8482.          AGO   .DOB
  8483. .*
  8484. .LT      ANOP
  8485. &L       LT    &T(3),&T(4)
  8486.          AGO   .DOB
  8487. .*
  8488. .TF      ANOP
  8489.          AIF   ('&T(4)' EQ '').TF1
  8490. &L       TF    &T(3),&T(4)
  8491.          AGO   .DOB
  8492. .*
  8493. .TF1     ANOP
  8494. &L       TF    &T(3)
  8495. .*
  8496. .DOB     ANOP
  8497. &CC      SETC  '&BC.NZ'
  8498. &K       SETA  K'&BC+2
  8499.          AIF   ('&T(5)' EQ '').TCC
  8500. &CC      SETC  '&BC&T(5)'
  8501. &K       SETA  K'&BC+K'&T(5)
  8502. .TCC     ANOP
  8503.          AIF   (&K LE 2).DCC
  8504.          AIF   ('&CC'(1,2) NE 'NN').DCC
  8505. &CC      SETC  '&CC'(3,&K-2)
  8506. .DCC     ANOP
  8507.          AIF   ('&CC' EQ 'LE').BLE
  8508.          AIF   ('&CC' EQ 'EH').BEH
  8509.          AIF   ('&CC' EQ 'LH').BLH
  8510.          AIF   ('&CC' EQ 'NLE').BNLE
  8511.          AIF   ('&CC' EQ 'NEH').BNEH
  8512.          AIF   ('&CC' EQ 'NLH').BNLH
  8513.          AIF   ('&CC' EQ 'MZ').BMZ
  8514.          AIF   ('&CC' EQ 'ZP').BZP
  8515.          AIF   ('&CC' EQ 'MP').BMP
  8516.          AIF   ('&CC' EQ 'NMZ').BNMZ
  8517.          AIF   ('&CC' EQ 'NZP').BNZP
  8518.          AIF   ('&CC' EQ 'NMP').BNMP
  8519.          B&CC  *+4+&C
  8520. .BOP     &OP   &A,&B
  8521.          MEXIT
  8522. .*
  8523. .BLE     BLE   *+4+&C
  8524.          AGO   .BOP
  8525. .*
  8526. .BEH     BEH   *+4+&C
  8527.          AGO   .BOP
  8528. .*
  8529. .BLH     BLH   *+4+&C
  8530.          AGO   .BOP
  8531. .*
  8532. .BNLE    BNLE  *+4+&C
  8533.          AGO   .BOP
  8534. .*
  8535. .BNEH    BNEH  *+4+&C
  8536.          AGO   .BOP
  8537. .*
  8538. .BNLH    BNLH  *+4+&C
  8539.          AGO   .BOP
  8540. .*
  8541. .BMZ     BMZ   *+4+&C
  8542.          AGO   .BOP
  8543. .*
  8544. .BZP     BZP   *+4+&C
  8545.          AGO   .BOP
  8546. .*
  8547. .BMP     BMP   *+4+&C
  8548.          AGO   .BOP
  8549. .*
  8550. .BNMZ    BNMZ  *+4+&C
  8551.          AGO   .BOP
  8552. .*
  8553. .BNZP    BNZP  *+4+&C
  8554.          AGO   .BOP
  8555. .*
  8556. .BNMP    BNMP  *+4+&C
  8557.          AGO   .BOP
  8558. .*
  8559. .OP      ANOP
  8560. &L       &OP   &A,&B
  8561. .END     MEND
  8562. ./       ADD   LIST=ALL,NAME=SYSXXC
  8563.          MACRO
  8564. &L       SYSXXC &OP,&A,&B,&C,&D1=0,&D2=0,&N=,&BC=
  8565.          LCLC  &LBL,&BCLBL,&LQ
  8566.          LCLA  &M,&X,&Y
  8567. &LBL     SETC  '&L'
  8568.          AIF   ('&N' NE '' AND '&N' NE '*').N
  8569. .*
  8570. .*  NO. OF INSTRUCTIONS NOT SPECIFIED
  8571. .*
  8572.          AIF   ('&C' NE '').CHECK
  8573.          AIF  (T'&A NE 'M' AND T'&A NE 'N' AND T'&A NE 'O' AND         *
  8574.                T'&A NE 'T' AND T'&A NE 'U' AND T'&A NE 'W' AND         *
  8575.                T'&A NE '$').OKLEN
  8576.          MNOTE *,'LENGTH NOT CODED AND LENGTH ATTRIBUTE NOT AVAILABLE T*
  8577.                O MACROS'
  8578. &LQ      SETC  'L'''
  8579. &L       SYSXXC &OP,&A,&B,&LQ&A,D1=&D1,D2=&D2,N=&N,BC=&BC
  8580.          MEXIT
  8581. .*
  8582. .OKLEN   ANOP
  8583. &M       SETA  L'&A
  8584. &L       SYSXXC &OP,&A,&B,&M,D1=&D1,D2=&D2,N=&N,BC=&BC
  8585.          MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&M)'
  8586.          MEXIT
  8587. .*
  8588. .CHECK   ANOP
  8589. &Y       SETA  &Y+1
  8590.          AIF   (&Y GT K'&C).OK
  8591.          AIF   ('&C'(&Y,1) LT '0').ONE
  8592.          AGO   .CHECK
  8593. .OK      ANOP
  8594. .*
  8595.          AIF   (&C LE 256).ONE
  8596. .NEXT    ANOP
  8597. &LBL     SYSXXCA &OP,&A,&B,256,D1=&D1+&X,D2=&D2+&X
  8598. &LBL     SETC  ''
  8599.          AIF   ('&BC(1)' EQ '').NBC
  8600.          AIF   ('&BCLBL' NE '').BCA
  8601. &BCLBL   SETC  '&BC(2)'
  8602.          AIF   ('&BCLBL' NE '').BCA
  8603. &BCLBL   SETC  '&OP&SYSNDX'
  8604. .BCA     &BC(1) &BCLBL
  8605. .NBC     ANOP
  8606. &X       SETA  &X+256
  8607. &Y       SETA  &C-&X
  8608.          AIF   (&Y GT 256).NEXT
  8609.          SYSXXCA &OP,&A,&B,&Y,D1=&D1+&X,D2=&D2+&X
  8610. &BCLBL   SYSLBL
  8611.          MEXIT
  8612. .*
  8613. .*  NO. OF INSTRUCTIONS SPECIFIED
  8614. .*
  8615. .N       ANOP
  8616. &M       SETA  &N
  8617.          AIF   (&M LE 1).ONE
  8618. .LOOP    ANOP
  8619.          AIF   (&X GE &M-1).LAST
  8620. &LBL     SYSXXCA &OP,&A,&B,(&C)/&M,D1=&D1+(&C)/&M*&X,D2=&D2+(&C)/&M*&X
  8621. &LBL     SETC  ''
  8622. &X       SETA  &X+1
  8623.          AIF   ('&BC(1)' EQ '').LOOP
  8624.          AIF   ('&BCLBL' NE '').BCB
  8625. &BCLBL   SETC  '&BC(2)'
  8626.          AIF   ('&BCLBL' NE '').BCB
  8627. &BCLBL   SETC  '&OP&SYSNDX'
  8628. .BCB     &BC(1) &BCLBL
  8629.          AGO   .LOOP
  8630. .LAST    ANOP
  8631.     SYSXXCA &OP,&A,&B,&C-(&C)/&M*&X,D1=&D1+(&C)/&M*&X,D2=&D2+(&C)/&M*&X
  8632. &BCLBL   SYSLBL
  8633.          MEXIT
  8634. .*
  8635. .ONE     ANOP
  8636. &L       SYSXXCA &OP,&A,&B,&C,D1=&D1,D2=&D2
  8637. .END     MEND
  8638. ./       ADD   LIST=ALL,NAME=SYSXXCA
  8639.          MACRO
  8640. &L       SYSXXCA &OP,&A,&B,&C,&D1=0,&D2=0
  8641.          LCLA  &LEN
  8642.          LCLC  &LQ
  8643. .*
  8644.          AIF   ('&C' NE '').NDLEN
  8645.          AIF  (T'&A NE 'M' AND T'&A NE 'N' AND T'&A NE 'O' AND         *
  8646.                T'&A NE 'T' AND T'&A NE 'U' AND T'&A NE 'W' AND         *
  8647.                T'&A NE '$').OKLEN
  8648.          MNOTE *,'LENGTH NOT CODED AND LENGTH ATTRIBUTE NOT AVAILABLE T*
  8649.                O MACROS'
  8650. &LQ      SETC  'L'''
  8651. &L       SYSXXCA &OP,&A,&B,&LQ&A,D1=&D1,D2=&D2
  8652.          MEXIT
  8653. .*
  8654. .OKLEN   ANOP
  8655. &LEN     SETA  L'&A
  8656. &L       SYSXXCA &OP,&A,&B,&LEN,D1=&D1,D2=&D2
  8657.          MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&LEN)'
  8658.          MEXIT
  8659. .*
  8660. .NDLEN   ANOP
  8661. .*
  8662.          AIF   ('&A'(1,1) EQ '(').AR
  8663.          AIF   ('&B'(1,1) EQ '(').C2
  8664. .*
  8665. .C1      ANOP
  8666.          AIF   ('&D1' EQ '0').D1Z
  8667.          AIF   ('&D2' EQ '0').C1B
  8668. .*
  8669. .C1A     ANOP
  8670. &L       SYSXXCB &OP,&D1+&A,&D2+&B,&C
  8671.          MEXIT
  8672. .*
  8673. .C1B     ANOP
  8674. &L       SYSXXCB &OP,&D1+&A,&B,&C
  8675.          MEXIT
  8676. .*
  8677. .D1Z     ANOP
  8678.          AIF   ('&D2' EQ '0').C1D
  8679. .*
  8680. .C1C     ANOP
  8681. &L       SYSXXCB &OP,&A,&D2+&B,&C
  8682.          MEXIT
  8683. .*
  8684. .C1D     ANOP
  8685. &L       SYSXXCB &OP,&A,&B,&C
  8686.          MEXIT
  8687. .*
  8688. .C2      ANOP
  8689.          AIF   ('&D1' EQ '0').C2B
  8690. .*
  8691. .C2A     ANOP
  8692. &L       SYSXXCB &OP,&D1+&A,&D2&B,&C
  8693.          MEXIT
  8694. .*
  8695. .C2B     ANOP
  8696. &L       SYSXXCB &OP,&A,&D2&B,&C
  8697.          MEXIT
  8698. .*
  8699. .AR      AIF   ('&B'(1,1) EQ '(').C4
  8700. .*
  8701. .C3      ANOP
  8702.          AIF   ('&D2' EQ '0').C3B
  8703. .*
  8704. .C3A     ANOP
  8705. &L       SYSXXCB &OP,&D1&A,&D2+&B,&C
  8706.          MEXIT
  8707. .*
  8708. .C3B     ANOP
  8709. &L       SYSXXCB &OP,&D1&A,&B,&C
  8710.          MEXIT
  8711. .*
  8712. .C4      ANOP
  8713. &L       SYSXXCB &OP,&D1&A,&D2&B,&C
  8714.          MEND
  8715. ./       ADD   LIST=ALL,NAME=SYSXXCB
  8716.          MACRO
  8717. &L       SYSXXCB &OP,&A,&B,&C
  8718.          LCLA  &X,&Y,&Z
  8719.          LCLC  &CL(8),&CR(8)
  8720.          AIF   ('&A' NE '').OK
  8721. &L       &OP   0(&C),&B
  8722.          MEXIT
  8723. .*
  8724. .OK      ANOP
  8725.          AIF   ('&A'(K'&A,1) EQ ')').SCAN
  8726. .*
  8727. .SIMPLE  ANOP
  8728. &L       &OP   &A.(&C),&B
  8729.          MEXIT
  8730. .*
  8731. .SCAN    ANOP
  8732. &X       SETA  &X+1
  8733.          AIF   (&X GT K'&A).SIMPLE
  8734.          AIF   ('&A'(&X,1) EQ '''').QUOTE
  8735.          AIF   ('&A'(&X,1) NE '(').SCAN
  8736.          AIF   (&X EQ 1).SCAN
  8737.          AIF   ('&A'(&X-1,1) EQ '+').SCAN
  8738.          AIF   ('&A'(&X-1,1) EQ '-').SCAN
  8739.          AIF   ('&A'(&X-1,1) EQ '*').SCAN
  8740.          AIF   ('&A'(&X-1,1) EQ '/').SCAN
  8741.          AIF   ('&A'(&X-1,1) EQ '(').SCAN
  8742. .LOOPL   ANOP
  8743. &Y       SETA  &Y+1
  8744.          AIF   (&Y*8 GE &X).DONEL
  8745. &CL(&Y) SETC   '&A'((&Y-1)*8+1,8)
  8746.          AGO   .LOOPL
  8747. .*
  8748. .DONEL   ANOP
  8749. &CL(&Y)  SETC  '&A'((&Y-1)*8+1,&X-(&Y-1)*8)
  8750. .*
  8751. .LOOPR   ANOP
  8752. &Z       SETA  &Z+1
  8753.          AIF   (&Z*8 GE K'&A-&X).DONER
  8754. &CR(&Z)  SETC  '&A'(&X+(&Z-1)*8+1,8)
  8755.          AGO   .LOOPR
  8756. .*
  8757. .DONER   ANOP
  8758. &CR(&Z) SETC   '&A'(&X+(&Z-1)*8+1,K'&A-&X-(&Z-1)*8)
  8759. .*
  8760. &L       &OP   &CL(1)&CL(2)&CL(3)&CL(4)&CL(5)&CL(6)&CL(7)&CL(8)&C,&CR(1*
  8761.                )&CR(2)&CR(3)&CR(4)&CR(5)&CR(6)&CR(7)&CR(8),&B
  8762.          MEXIT
  8763. .*
  8764. .QUOTE   ANOP
  8765.          AIF   (&X EQ 1).QUOTEL
  8766.          AIF   ('&A'(&X-1,1) EQ 'L').SCAN
  8767. .*
  8768. .QUOTEL  ANOP
  8769. &X       SETA  &X+1
  8770.          AIF   (&X GE K'&A).SIMPLE
  8771.          AIF   ('&A'(&X,1) NE '''').QUOTEL
  8772.          AGO   .SCAN
  8773.          MEND
  8774. ./       ADD   LIST=ALL,NAME=SYSXXC1
  8775.          MACRO
  8776. &L       SYSXXC1 &OP,&A,&T,&C,&D1=0,&N=,&BC=
  8777.          LCLC  &LBL,&BCLBL
  8778.          LCLA  &M,&X,&Y
  8779. &LBL     SETC  '&L'
  8780.          AIF   ('&N' NE '' AND '&N' NE '*').N
  8781. .*
  8782. .*  NO. OF INSTRUCTIONS NOT SPECIFIED
  8783. .*
  8784.          AIF   ('&C' EQ '').ONE
  8785. .CHECK   ANOP
  8786. &Y       SETA  &Y+1
  8787.          AIF   (&Y GT K'&C).OK
  8788.          AIF   ('&C'(&Y,1) LT '0').ONE
  8789.          AGO   .CHECK
  8790. .OK      ANOP
  8791. .*
  8792.          AIF   (&C LE 256).ONE
  8793. .NEXT    ANOP
  8794. &LBL     SYSXXCA &OP,&A,&T,256,D1=&X
  8795. &LBL     SETC  ''
  8796.          AIF   ('&BC(1)' EQ '').NBC
  8797.          AIF   ('&BCLBL' NE '').BCA
  8798. &BCLBL   SETC  '&BC(2)'
  8799.          AIF   ('&BCLBL' NE '').BCA
  8800. &BCLBL   SETC  '&OP&SYSNDX'
  8801. .BCA     &BC(1) &BCLBL
  8802. .NBC     ANOP
  8803. &X       SETA  &X+256
  8804. &Y       SETA  &C-&X
  8805.          AIF   (&Y GT 256).NEXT
  8806.          SYSXXCA &OP,&A,&T,&Y,D1=&X
  8807. &BCLBL   SYSLBL
  8808.          MEXIT
  8809. .*
  8810. .*  NO. OF INSTRUCTIONS SPECIFIED
  8811. .*
  8812. .N       ANOP
  8813. &M       SETA  &N
  8814.          AIF   (&M LE 1).ONE
  8815. .LOOP    ANOP
  8816.          AIF   (&X GE &M-1).LAST
  8817. &LBL     SYSXXCA &OP,&A,&T,(&C)/&M,D1=&D1+(&C)/&M*&X
  8818. &LBL     SETC  ''
  8819. &X       SETA  &X+1
  8820.          AIF   ('&BC(1)' EQ '').LOOP
  8821.          AIF   ('&BCLBL' NE '').BCB
  8822. &BCLBL   SETC  '&BC(2)'
  8823.          AIF   ('&BCLBL' NE '').BCB
  8824. &BCLBL   SETC  '&OP&SYSNDX'
  8825. .BCB     &BC(1) &BCLBL
  8826.          AGO   .LOOP
  8827. .LAST    ANOP
  8828.          SYSXXCA &OP,&A,&T,&C-(&C)/&M*&X,D1=&D1+(&C)/&M*&X
  8829. &BCLBL   SYSLBL
  8830.          MEXIT
  8831. .*
  8832. .ONE     ANOP
  8833. &L       SYSXXCA &OP,&A,&T,&C,D1=&D1
  8834. .END     MEND
  8835. ./       ADD   LIST=ALL,NAME=TF
  8836.          MACRO
  8837. &L       TF
  8838.          LCLA  &X,&Y,&Z,&I
  8839.          LCLC  &F(16)
  8840. .*
  8841.          AIF   (N'&SYSLIST LT 1).NONE
  8842. .LOOP    ANOP
  8843. &X       SETA  &X+1
  8844.          AIF   (&X GT N'&SYSLIST).DONE
  8845. .*
  8846.          AIF   (&Z GE 16).MANY
  8847. .*
  8848. &F(&Z+1) SETC  '+L'''(1,3)
  8849. &F(&Z+2) SETC  '&SYSLIST(&X)'
  8850. &I       SETA  0
  8851. .SCAN    ANOP
  8852. &I       SETA  &I+1
  8853.          AIF   (&I GT K'&F(&Z+2)).SCANOK
  8854.          AIF   ('&F(&Z+2)'(&I,1) GE 'A').SCAN
  8855.          AIF   (&I LE 1).SCANOK
  8856. &F(&Z+2) SETC  '&F(&Z+2)'(1,&I-1)
  8857. .SCANOK  ANOP
  8858. .*
  8859. &Y       SETA  &Z+2
  8860. .CHECK   ANOP
  8861. &Y       SETA  &Y-2
  8862.          AIF   (&Y LT 2).UNIQUE
  8863.          AIF   ('&F(&Z+2)' NE '&F(&Y)').CHECK
  8864.          MNOTE 4,'"&F(&Z+2)" IS SPECIFIED MORE THAN ONCE'
  8865. &F(&Z+1) SETC  ''
  8866. &F(&Z+2) SETC  ''
  8867.          AGO   .LOOP
  8868. .*
  8869. .UNIQUE  ANOP
  8870.          AIF   (&X LE 1).NTEST
  8871.          TM    0,(&F(&Z+2)-&F(2))*256
  8872.          ORG   *-4
  8873. .NTEST   ANOP
  8874. &Z       SETA  &Z+2
  8875.          AGO   .LOOP
  8876. .*
  8877. .DONE    ANOP
  8878. &F(1)    SETC  'L'''(1,2)
  8879. &L       TM    &SYSLIST(1),&F(1)&F(2)&F(3)&F(4)&F(5)&F(6)&F(7)&F(8)&F(9*
  8880.                )&F(10)&F(11)&F(12)&F(13)&F(14)&F(15)&F(16)
  8881.          MEXIT
  8882. .*
  8883. .NONE    ANOP
  8884.          MNOTE 12,'NO FLAGS SPECIFIED'
  8885.          CLI   *+1,0
  8886.          MEXIT
  8887. .*
  8888. .MANY    ANOP
  8889.          MNOTE 12,'TOO MANY FLAGS SPECIFIED'
  8890.          AGO   .DONE
  8891.          MEND
  8892. ./       ADD   LIST=ALL,NAME=TIME128
  8893.          MACRO
  8894. &L       TIME128
  8895. &L       OSCALL TIME128
  8896.          MEND
  8897. ./       ADD   LIST=ALL,NAME=TIOTSRCH
  8898.          MACRO
  8899. &L       TIOTSRCH &R,&S,&DD,&UCB=YES
  8900.          LCLC  &LBL
  8901.          SYSKWT UCB,&UCB,(YES,NO),NULL=NO,COND=NO
  8902. &L       L     &R,16
  8903.          L     &R,0(,&R)
  8904.          L     &R,0(,&R)
  8905.          L     &R,12(,&R)
  8906.          LA    &R,24(,&R)
  8907.          SLR   &S,&S
  8908. TIO&SYSNDX.A IC &S,0(,&R)
  8909.          LTR   &S,&S
  8910.          BZ    TIO&SYSNDX.C
  8911.          CLC   4(8,&R),&DD
  8912.          BE    TIO&SYSNDX.B
  8913.          ALR   &R,&S
  8914.          B     TIO&SYSNDX.A
  8915. &LBL     SETC  'TIO&SYSNDX.B'
  8916.          AIF   ('&UCB' EQ 'NO').NUCB
  8917. &LBL     L     &R,16(,&R)
  8918. &LBL     SETC  ''
  8919.          LA    &R,0(,&R)
  8920. .NUCB    ANOP
  8921. &LBL     LTR   &S,&S
  8922. &LBL     SETC  ''
  8923. TIO&SYSNDX.C DS 0H
  8924.          MEND
  8925. ./       ADD   LIST=ALL,NAME=UAOP
  8926.          MACRO
  8927. &L       UAOP  &OP,&R,&A
  8928. &L       &OP   &R,*-*
  8929.          ORG   *-2
  8930.          DC    S(&A)
  8931.          MEND
  8932. ./       ADD   LIST=ALL,NAME=VAREA
  8933.          MACRO
  8934. &L       VAREA
  8935.          GBLA  &VAREA
  8936. &L       DS    0F,XL&VAREA
  8937.          MEND
  8938. ./       ADD   LIST=ALL,NAME=VCLEAR
  8939.          MACRO
  8940. &L       VCLEAR &AREA
  8941.          AIF   ('&AREA' NE '').AOK
  8942.          MNOTE 12,'VAREA ADDRESS REQUIRED'
  8943.          MEXIT
  8944. .*
  8945. .AOK     ANOP
  8946. .*
  8947.          AIF   ('&AREA'(1,1) EQ '(').REG
  8948. &L       MMVC  12+&AREA,4+&AREA,8
  8949.          MEXIT
  8950. .*
  8951. .REG     ANOP
  8952. &L       MMVC  12&AREA,4&AREA,8
  8953.          MEND
  8954. ./       ADD   LIST=ALL,NAME=VINIT
  8955.          MACRO
  8956. &L       VINIT &AREA,&RTN,&LOC,&LEN
  8957.          AIF   ('&AREA' NE '').AOK
  8958.          MNOTE 12,'VAREA ADDRESS REQUIRED'
  8959.          MEXIT
  8960. .*
  8961. .AOK     ANOP
  8962. .*
  8963. &L       SYSLR VRF,&RTN,ERR='OUTPUT ROUTINE ADDRESS REQUIRED'
  8964.          SYSQS VR1,VR0,&LOC,&LEN
  8965.          AIF   ('&AREA'(1,1) EQ '(').REG
  8966.          STM   VRF,VR1,&AREA
  8967.          STM   VR0,VR1,12+&AREA
  8968.          MEXIT
  8969. .*
  8970. .REG     ANOP
  8971.          STM   VRF,VR1,0&AREA
  8972.          STM   VR0,VR1,12&AREA
  8973.          MEND
  8974. ./       ADD   LIST=ALL,NAME=VOUT
  8975.          MACRO
  8976. &L       VOUT  &AREA,&LOC,&LEN,&DEBLANK=,&WGET=,&OFFSET=
  8977.          AIF   ('&LOC&LEN' EQ '').NVSEG
  8978. &L      VSEG &AREA,&LOC,&LEN,DEBLANK=&DEBLANK,WGET=&WGET,OFFSET=&OFFSET
  8979.          AGO   .COM
  8980. .*
  8981. .NVSEG   ANOP
  8982. &L       SYSLR VRE,&AREA,ERR='VAREA ADDRESS REQUIRED'
  8983. .*
  8984. .COM     ANOP
  8985.          LM    VR0,VR1,4(VRE)
  8986.          S     VR0,12(VRE)
  8987.          MVC   12(8,VRE),4(VRE)
  8988.          L     RTNR,0(VRE)
  8989.          SLR   VRF,VRF
  8990.          CCALL (RTNR)
  8991.          MEND
  8992. ./       ADD   LIST=ALL,NAME=VSEG
  8993.          MACRO
  8994. &L       VSEG  &AREA,&LOC,&LEN,&DEBLANK=,&WGET=,&OFFSET=
  8995.          SYSKWT DEBLANK,&DEBLANK,(YES,NO),COND=NO
  8996.          SYSKWT WGET,&WGET,(YES,NO)
  8997. &L       SYSLR VRE,&AREA,ERR='VAREA ADDRESS REQUIRED'
  8998.          SYSQS VR1,VR0,&LOC,&LEN,TYPEA=&WGET,SELECTA=(YES)
  8999.          SYSLR VRF,&OFFSET
  9000.          AIF   ('&DEBLANK' EQ 'YES').DB
  9001.          CCALL VSEG
  9002.          MEXIT
  9003. .*
  9004. .DB      CCALL VSEGDB
  9005.          MEND
  9006. ./       ADD   LIST=ALL,NAME=VTELL
  9007.          MACRO
  9008. &L       VTELL &AREA
  9009.          AIF   ('&AREA' NE '').AOK
  9010.          MNOTE 12,'VAREA ADDRESS REQUIRED'
  9011.          MEXIT
  9012. .*
  9013. .AOK     ANOP
  9014. .*
  9015.          AIF   ('&AREA'(1,1) EQ '(').REG
  9016. &L       LM    VR0,VR1,4+&AREA
  9017.          L     VRF,12+&AREA
  9018.          SLR   VR0,VRF
  9019.          MEXIT
  9020. .*
  9021. .REG     ANOP
  9022. &L       LM    VR0,VR1,4&AREA
  9023.          L     VRF,12&AREA
  9024.          SLR   VR0,VRF
  9025.          MEND
  9026. ./       ADD   LIST=ALL,NAME=VTEST
  9027.          MACRO
  9028. &L       VTEST &AREA,&LEN
  9029.          AIF   ('&AREA' NE '').AOK
  9030.          MNOTE 12,'VAREA ADDRESS REQUIRED'
  9031.          MEXIT
  9032. .*
  9033. .AOK     ANOP
  9034. .*
  9035. &L       SYSLR RTNR,&LEN,ERR='LENGTH REQUIRED'
  9036.          AIF   ('&AREA'(1,1) EQ '(').REG
  9037.          S     RTNR,12+&AREA
  9038.          LCR   RTNR,RTNR
  9039.          MEXIT
  9040. .*
  9041. .REG     ANOP
  9042.          S     RTNR,12&AREA
  9043.          LCR   RTNR,RTNR
  9044.          MEND
  9045. ./       ADD   LIST=ALL,NAME=WADDR
  9046.          MACRO
  9047. &L       WADDR &R,&LOC
  9048. &L       L     &R,&LOC
  9049.          MEND
  9050. ./       ADD   LIST=ALL,NAME=WCALL
  9051.          MACRO
  9052. &L       WCALL &SUBR,&TYPE,&RETURN=,&TEST=,                            *
  9053.                &VRE=,&VRF=,&VR0=,&VR1=
  9054. &L       CCALL &SUBR,&TYPE,RETURN=&RETURN,TEST=&TEST,                  *
  9055.                VRE=&VRE,VRF=&VRF,VR0=&VR0,VR1=&VR1
  9056.          MEND
  9057. ./       ADD   LIST=ALL,NAME=WENTER
  9058.          MACRO
  9059. &L       WENTER &R,&S,&SIZE,&ENTRY=,&BASE=,&WAR=,                      *
  9060.                &CHECK=,&TRACE=,&ID=
  9061. &L       CENTER &R,&S,&SIZE,ENTRY=&ENTRY,BASE=&BASE,WAR=&WAR
  9062.          MEND
  9063. ./       ADD   LIST=ALL,NAME=WEXIT
  9064.          MACRO
  9065. &L       WEXIT &R,&S,&SIZE,&WAR=,<R=,&BRANCH=,                       *
  9066.                &CHECK=,&TRACE=,&ID=
  9067. &L       CEXIT &R,&S,&SIZE,LTR=<R,WAR=&WAR,BRANCH=&BRANCH
  9068.          MEND
  9069. ./       ADD   LIST=ALL,NAME=WPARMGBL
  9070. *
  9071. *  NIH/COMMON - DUMMY FOR WYLBUR GLOBAL DECLARATIONS
  9072. *
  9073. ./       ADD   LIST=ALL,NAME=WPOP
  9074.          MACRO
  9075. &L       WPOP  &R,&SIZE,&EXTRA=0,&CHECK=
  9076. &L       CPOP  &R,&SIZE,EXTRA=&EXTRA
  9077.          MEND
  9078. ./       ADD   LIST=ALL,NAME=WPOPREG
  9079.          MACRO
  9080. &L       WPOPREG &R,&S,&CHECK=
  9081. &L       CPOPREG &R,&S
  9082.          MEND
  9083. ./       ADD   LIST=ALL,NAME=WPUSH
  9084.          MACRO
  9085. &L       WPUSH &R,&SIZE,&EXTRA=0,&CHECK=
  9086. &L       CPUSH &R,&SIZE,EXTRA=&EXTRA
  9087.          MEND
  9088. ./       ADD   LIST=ALL,NAME=WPUSHREG
  9089.          MACRO
  9090. &L       WPUSHREG &R,&S,&CHECK=
  9091. &L       CPUSHREG &R,&S
  9092.          MEND
  9093. ./       ADD   LIST=ALL,NAME=WSA
  9094.          MACRO
  9095. &L       WSA   &R,&S,&EQU=
  9096. &L       CSA   &R,&S,EQU=&EQU
  9097.          MEND
  9098. ./       ADD   LIST=ALL,NAME=Z
  9099.          MACRO
  9100. &L       Z     &R,&A
  9101.          AIF   ('&R' NE '').REG
  9102. &L       MZC   &A,4
  9103.          MEXIT
  9104. .REG     ANOP
  9105. &L       SLR   &R,&R
  9106.          ST    &R,&A
  9107.          MEND
  9108. ./       ADD   LIST=ALL,NAME=ZB
  9109.          MACRO
  9110. &L       ZB    &R,&A
  9111.          AIF   ('&R' NE '').REG
  9112. &L       MVI   &A,0
  9113.          MEXIT
  9114. .REG     ANOP
  9115. &L       SLR   &R,&R
  9116.          STC   &R,&A
  9117.          MEND
  9118. ./       ADD   LIST=ALL,NAME=ZF
  9119.          MACRO
  9120. &L       ZF
  9121.          LCLA  &X,&Y,&Z,&I
  9122.          LCLC  &F(16)
  9123. .*
  9124.          AIF   (N'&SYSLIST LT 1).NONE
  9125. .LOOP    ANOP
  9126. &X       SETA  &X+1
  9127.          AIF   (&X GT N'&SYSLIST).DONE
  9128. .*
  9129.          AIF   (&Z GE 16).MANY
  9130. .*
  9131. &F(&Z+1) SETC  '+L'''(1,3)
  9132. &F(&Z+2) SETC  '&SYSLIST(&X)'
  9133. &I       SETA  0
  9134. .SCAN    ANOP
  9135. &I       SETA  &I+1
  9136.          AIF   (&I GT K'&F(&Z+2)).SCANOK
  9137.          AIF   ('&F(&Z+2)'(&I,1) GE 'A').SCAN
  9138.          AIF   (&I LE 1).SCANOK
  9139. &F(&Z+2) SETC  '&F(&Z+2)'(1,&I-1)
  9140. .SCANOK  ANOP
  9141. .*
  9142. &Y       SETA  &Z+2
  9143. .CHECK   ANOP
  9144. &Y       SETA  &Y-2
  9145.          AIF   (&Y LT 2).UNIQUE
  9146.          AIF   ('&F(&Z+2)' NE '&F(&Y)').CHECK
  9147.          MNOTE 4,'"&F(&Z+2)" IS SPECIFIED MORE THAN ONCE'
  9148.          AGO   .LOOP
  9149. .*
  9150. .UNIQUE  ANOP
  9151.          AIF   (&X LE 1).NTEST
  9152.          NI    0,(&F(&Z+2)-&F(2))*256
  9153.          ORG   *-4
  9154. .NTEST   ANOP
  9155. &Z       SETA  &Z+2
  9156.          AGO   .LOOP
  9157. .*
  9158. .DONE    ANOP
  9159. &F(1)    SETC  'L'''(1,2)
  9160. &L       ZI    &SYSLIST(1),&F(1)&F(2)&F(3)&F(4)&F(5)&F(6)&F(7)&F(8)&F(9*
  9161.                )&F(10)&F(11)&F(12)&F(13)&F(14)&F(15)&F(16)
  9162.          MEXIT
  9163. .*
  9164. .NONE    ANOP
  9165.          MNOTE 12,'NO FLAGS SPECIFIED'
  9166.          CLI   *+1,0
  9167.          MEXIT
  9168. .*
  9169. .MANY    ANOP
  9170.          MNOTE 12,'TOO MANY FLAGS SPECIFIED'
  9171.          AGO   .DONE
  9172.          MEND
  9173. ./       ADD   LIST=ALL,NAME=ZH
  9174.          MACRO
  9175. &L       ZH    &R,&A
  9176.          AIF   ('&R' NE '').REG
  9177. &L       MZC   &A,2
  9178.          MEXIT
  9179. .REG     ANOP
  9180. &L       SLR   &R,&R
  9181.          STH   &R,&A
  9182.          MEND
  9183. ./       ADD   LIST=ALL,NAME=ZHB
  9184.          MACRO
  9185. &L       ZHB   &R,&A
  9186. &L       ZB    &R,&A
  9187.          MEND
  9188. ./       ADD   LIST=ALL,NAME=ZHBR
  9189.          MACRO
  9190. &L       ZHBR  &R
  9191.          AIF   ('&R' EQ '0' OR '&R' EQ 'R0' OR '&R' EQ 'VR0').N
  9192. &L       LA    &R,0(,&R)
  9193.          MEXIT
  9194. .*
  9195. .N       ANOP
  9196. &L       N     &R,=XL4'00FFFFFF'
  9197.          MEND
  9198. ./       ADD   LIST=ALL,NAME=ZI
  9199.          MACRO
  9200. &L       ZI    &A,&B
  9201. &L       NI    &A,255-(&B)
  9202.          MEND
  9203. ./       ADD   LIST=ALL,NAME=ZR
  9204.          MACRO
  9205. &L       ZR    &R
  9206. &L       SR    &R,&R
  9207.          MEND
  9208. ./       ADD   LIST=ALL,NAME=ZZZZZZZZ
  9209. ALP;
  9210. END;
  9211.